;[I4-TENEX]<MFEXEC>X2CMD.MAC;20205,  4-DEC-79 11:12:24, Ed: RLWSSD
; DEFAULT "TYPE" WIDTH TO LPTWID AT IAC
;[I4-TENEX]<MFEXEC>X2CMD.MAC;20204, 15-OCT-79 16:32:40, Ed: RLWSSD
; CALL JERR -> JFCL AT REDI4+12
;[I4-TENEX]<MFEXEC>X2CMD.MAC;20203, 12-SEP-79 13:06:59, Ed: RLWSSD
;[I4-TENEX]<MFEXEC>X2CMD.MAC;20202, 12-SEP-79 12:24:03, Ed: RLWSSD
;[I4-TENEX]<MFEXEC>X2CMD.MAC;20201, 12-SEP-79 12:16:54, Ed: RLWSSD
; MAKE REDIRECT WITH CONTINUE/REENTER/START WORK; SOMEBODY FORGOT
; TO DO AN SPJFN OF LOWER FORK BEFORE EXECUTING.
;<MFEXEC>X2CMD.MAC;20200  27-SEP-78 18:14:48  EDIT BY B-SMITH
;Fixed $OPNER to not clober C before it retries and to handle OPNX7
; correctly in the case of a terminal.
;<MFEXEC>X2CMD.MAC;20101  27-DEC-77 16:09:27  EDIT BY B-SMITH
;<MFEXEC>X2CMD.MAC;20100  30-NOV-77 09:37:42  EDIT BY B-SMITH
;2.01
;<MFEXEC>X2CMD.MAC;20000  11-JAN-77 19:53:37  EDIT BY B-SMITH
;2.00
;<ARMANTROUT>X2CMD.MAC;1  12-JUL-75 23:57:26  EDIT BY ARMANTROUT
;1.53
;<ARMANTROUT>X2CMD.MAC;1  17-MAR-75 17:05:49  EDIT BY ARMANTROUT
;<ARMANTROUT>X2CMD.MAC;1  14-DEC-74 00:10:33  EDIT BY ARMANTROUT
; 1.52
; $OPENF TRIES THAWED MODE IF OPENF FAILS ON READONLY OPEN
; "VERBATIM" SUBCOMMAND TO "LIST"  (PARC)
; CONVERT TO $SYSGT
; ADD "SITE" SUBCOMMAND TO LIST/TYPE
; LIST/TYPE OUTPUT COMMENT CHR DETERMINED FROM EXTENSION
; "WATCH" SUBCOMMAND FOR LIST
; GET WIDTH AND LENGTH FROM RFMOD IN LIST/TYPE (PARC)
; REPAIR ONE LAST EOL TO CRLF CONVERSION (LSTP2B)
; MAKE OVERWRITE MARGIN IN LIST/TYPE HEADING ROUTINE 40 WORDS INSTEAD
;  OF 20 WHICH WOULD LOSE IF FILENAME HAD LOTS OF ^V IN IT
; LIST OUTPUTS CRLF'S NOT EOL'S -- MAKE NET NUTS HAPPY

; 1.51
; IMPLEMENT IO REDIRECTION FOR "REDIRECT" AND "DETACH"
; CHANGE DEFAULT WIDTH FOR LPT: TO 72 FROM 75

; 1.50
; ADD THE "INDICATE (NULLS BY ^@)" SUBCOM TO "LIST/TYPE"
; FIX BUG IN "LIST" -- TRIED TO SOUT ZERO CHAR'S
; ADD NOISE TO "COPY" AND "APPEND"
; MAKE USE OF NEG. COUNT FOR SIN AND SOUT IN LIST FOR SPEED

; 1.49
; LIST: CONSIDER $ AND / AT LEFT MARGIN AS BEG. OF COMMENT LINE
; $OPENF FIXED TO NOT REOPEN PRIMARY I/O FILES

; 1.46


; PDP-10 MULTIPLE FORK EXECUTIVE

;ROUTINES TO DECODE AND EXECUTE SPECIFIC COMMANDS.
;THIS FILE CONTAINS SEVERAL OF THE LONGER AND NOT PARTICULARLY COMMON
;COMMANDS.  THEY ARE SEGREGATED FROM THE OTHER, SHORTER, COMMAND
;ROUTINES TO REDUCE THE EXEC'S NORMAL WORKING PAGE SET.

;CONTENTS
;	COPY/APPEND/TTYPE
;	LIST/TYPE
;	REDIRECT/DETACH

;TCOPY COMMAND:	TCOPY (FILES) <FILE GROUP>
;TTYPE COMMAND: TTYPE (FILES) <FILE GROUP>
;   EQUALS:
;		COPY <FILE GROUP> (TO) TTY:
;AND
;COPY COMMAND:  COPY <FILE GROUP> (TO) <FILE>
;AND
;APPEND COMMAND:  APPEND <FILE GROUP> TO <FILE>

;TAKE SUBCOMMANDS.

;MODE SUBCOMMAND --   LEGAL FOR--	MODE-BYTESIZE USED--
;ASCII		ANY DEVICES		1-7 WHERE LEGAL, ELSE 0-7
;IMAGE		ONE DEVICE MUST ACCEPT	10-8 WHERE LEGAL, ELSE 0-8
;		MODE 10, OTHER MUST
;		NOT BE LPT:.
;IMAGE BINARY	NEITHER DEVICE CAN	13-36 WHERE LEGAL, ELSE 0-36
;		BE TTY: OR LPT:
;BINARY		NEITHER DEVICE CAN	14-36 WHERE LEGAL, ELSE 0-36
;		BE TTY: OR LPT:.
;ASCII PARITY	PAPER TAPE SOURCE	SEE ASCII	NOT IMPLEMENTED
;DUMP		NON-DIRECTORY DTA OR MTA		NOT IMPLEMENTED

;FLAGS IN LH Z
;F1 ON FOR PAGES COPY, OTHERWISE OFF
;F2 ON FOR APPEND, OFF FOR COPY
;F3 ON IF OUTFILE WAS ALREADY OPEN (GROUP SOURCE CASE)

;FLAGS IN RH Z
;BITS FOR MODES SPECIFIED BY SUBCOMMANDS
; B35-N ON FOR MODE N, AS IN DVCHR WORD. THAT IS:
;1	NORMAL - SET IF BYTE SIZE SPECIFIED
;2	ASCII
;400	IMAGE
;4000	IMAGE BINARY
;10000	BINARY
;100000 DUMP

;AC USE
;AA  -1 OR BYTE SIZE AND MODE OF PREVIOUS COPY IN GROUP TO SAME DEST
;BB  - # BYTES PER PAGE WHEN COPYING BY BYTES
;CC  BYTE # OF EOF OF DISK SOURCE, # BYTES COPIED TO DSK DEST
;C, D, E, F   SEE 2 PAGES HENCE
;A, B, AND G ALSO USED LOCALLY

;COPY/APPEND/TTYPE
		PRINTX Entering X2CMD

.LLIST:
.LCOPY:	CALL $LPT		;DIRECTORY SUBCOMMAND SUBROUTINE
				;ASSIGN A JFN TO THE LINE-PRINTER
	JRST TCOPY1		;JOIN TCOPY

.TTYPE:
.TCOPY:	MOVE A,COJFN		;SEND OUTPUT TO EXECS OUTPUT DEVICE
	MOVEM A,OUTDSG
TCOPY1:	NOISE <files>
	CALL $INFG		;INPUT FILE GROUP
	 JRST CERR
	CONFIRM
	MOVE A,COJFN
	MOVE B,[BYTE (2) 0,1,1,1,1,1,1,2,1,2,2,1,0,2,1,1,1,1]
	MOVE C,[BYTE (2) 1,1,1,1,1,1,1,1,1,3,1,1,1,3]
	MOVE D,FK.COC
	ANDI D,3B25		;^L
	IOR B,D
	SFCOC
	SETO AA,
	JRST COPFL		;JOIN COPY AT TOP OF LOOP

.APPEN:	TLO Z,F2		;SAY APPEND NOT COPY
.COPY:	NOISE <file list>	;F2 IS OFF
				;GET FILE NAMES
	CALL .INFG		;GET INPUT FILE GROUP DESCRIPTOR
				;ALLOWS *'S, AND COMMAS IF THEY ARE
				;IMMEDIATE FILE NAME TERMINATOR.
	ALLOW TSPC+TALT+TLPR
	NOISE <to>
	MOVE A,[2,,2]		;DEFAULT NAME AND EXT SAME AS INPUT
	MOVEI B,(1B0+1B3)	;NORMAL OUTPUT FILE FLAGS FOR "COPY"
	TLNE Z,F2		;SKIP IF "COPY" NOT "APPEND"
	MOVEI B,(1B3)		;PRINT NEW FILE, ETC.
	CALL SPECFN		;COLLECT FILE NAME, GTJFN FLAGS IN RH B.
	 JRST CERR		; NO DEFAULT FOR "-" INPUT
	MOVEM A,OUTDSG		;DESTINATION JFN
	TLNN Z,F2
	JRST COP1A

;MAKE SURE DESTINATION DEVICE IS OK FOR "APPEND"
	HRRZ A,OUTDSG
	DVCHR
	LDB D,[POINT 9,B,17]	;GET DEVICE
	JUMPN D,[UERR[ASCIZ/Destination file must be on disk/]]
				;NO OTHER DEVICES WORK 12/3/70
COP1A:	CALL SPRTR		;ANALYZE TERMINATOR, READ MORE IF NEC. 3 RETS
	 JRST CERR
	 JRST [	CONFIRM		;COMMA. GET SUBCOMMANDS
		SUBCOM $COPY	;SUBCOMMANDS FROM TABLE $COPY
		JRST .+2]
	CONFIRM
	SETO AA,		;SAY NO PREVIOUS COPY IN GROUP
;TOP OF LOOP OVER INPUT FILE NAMES

COPFL:	CALL TYPIF		;TYPE INPUT FILE NAME IF PROCESSING GROUP
;WHEN OUTPUT FILE GROUP DESCRIPTORS IMPLEMENTED, DETERMINE HERE
;THE DESTINATION, AND SETO AA, UNLESS THE SAME AS BEFORE.

;COPY/APPEND...
;CHOOSE MODE AND BYTE SIZE FOR COPY/APPEND AS A FUNCTION OF 
;DEVICES AND SUBCOMMANDS GIVEN.

;AC USE
; C: SOURCE DEVICE TYPE NUMBER
; D: DESTINATION DEVICE TYPE NUMBER
; RH E: BYTE(6) READ MODE,WRITE MODE,BYTE SIZE
; F: DISC SOURCE BYTE SIZE

;SET UP E PER SUBCOMMAND, IGNORING FOR THE MOMENT WHETHER MODE
; IS LEGAL FOR DEVICES.
	TRNN Z,1		;BYTE SIZE GIVEN MEANS MODE 0
	SETZ E,		;FOR NO SUBCOMMAND, BYTE SIZE IS DEFAULTED LATER
	TRNE Z,2
	MOVEI E,010107
	TRNE Z,400
	MOVEI E,101010
	TRNE Z,4000
	MOVEI E,131344
	TRNE Z,10000
	MOVEI E,141444

;COPY/APPEND...
;DETERMINING MODE-BYTESIZE...
;FOR EACH FILE, DO A "DVCHR" TO GET TYPE NUMBER AND TO SEE IF MODE
; IS LEGAL FOR DEVICE.  CHANGE MODE TO 0 IF NOT LEGAL.
;DESTINATION
	HRRZ A,OUTDSG
	DVCHR
	TLNN B,B0
	ERROR <%1H: Can't do output>
	LDB D,[POINT 9,B,17]
	TRZ B,600000
	TRNN Z,(B)		;SKIP IF MODE SUBCOM GIVEN & OK FOR THIS DEVICE
	JRST [	TRZ E,007700		;WRITE IN MODE 0
		TRNN B,1		;CAN DEVICE USE MODE 0 ?
		UERR [ASCIZ /%1H: Can't do normal mode output/]
		JRST .+1]
;SOURCE
	HRRZ A,@INIFH1
	DVCHR
	TLNN B,B1
	ERROR <%1H: Can't do input>
	LDB C,[POINT 9,B,17]
	TRZ B,600000
	TRNN Z,(B)		;SUBCOMMAND GIVEN & OK ?
	JRST [	TRZ E,770000		;READ IN MODE 0
		TRNN B,1		;CAN DEVICE USE MODE 0?
		UERR [ASCIZ /%1H: Can't do normal mode input/]
		JRST .+1]
		;ALSO FOR DISK SOURCE GET BYTE SIZE IN F
	JUMPN C,COP2A
	HRRZ A,@INIFH1
	MOVE B,[1,,FDBBYV]		;BYTE SIZE IN B6-11
	PUSH P,C
	MOVEI C,F
	CALL $GTFDB		;DO GTFDB, NO SKIP ON NO ACCESS
	 ERROR <Access to source not allowed>
	POP P,C
	LDB F,[POINT 6,F,11]
COP2A:

;COPY/APPEND...
;DETERMINING MODE-BYTESIZE...

;IF MODE SUBCOMMAND IS ACCEPTABLE TO ONE DEVICE,
;IT IS ACCEPTED AND MODE 0 USED FOR OTHER DEVICE, PROVIDED OTHER
; DEVICE WILL ACCEPT THE BYTE SIZE (ONLY TTY AND LPT ARE RESTRICTED).
;IF MODE IS ACCEPTABLE TO NEITHER, ACTION DEPENDS ON SUBCOMMAND;
; IF UNACCEPTABLE A WARNING MESSAGE IS TYPED AND DEFAULT EXECUTION
; PROCEEDS, SO THAT A WHOLE GROUP COPY DOESN'T GET ABORTED.

	TRNN Z,177777		;ANY MODE SUBCOMMANDS GIVEN?
	JRST COPDEF		;NO, GO DEFAULT MODE AND BYTE SIZE
	TRNN Z,1		;MODE 0 REQUESTED, OR
	TRNE E,777700		;EITHER MODE NON-0?
	JRST COP3		;YES, SUBCOMMAND ACCEPTABLE TO ONE DEVICE
;SUBCOMMAND-DEPENDENT ACTION FOR SBCMD WHOSE MODE IS LEGAL FOR
;NEITHER SOURCE NOR DESTINATION DEVICE
	TRNE Z,2
	JRST [	MOVEI E,7	;ASCII ALWAYS LEGAL, USE 0-7.
		JRST COP3]
	TRNN Z,4000		;TREAT "IMAGE BINARY" AS "BINARY"
	TRNE Z,10000
	JRST [	MOVEI E,44	;"BINARY", USE 0-36, LEGAL EXCEPT FOR
		JRST COP3]	;TTY OR LPT, DETECTED AT COP3.
;ONLY IMAGE GETS THRU TO HERE
	JRST COPDF1		;GO TYPE MESSAGE AND DEFAULT
;IMAGE IS NOT INTERPRETED FOR DEVICES OTHER THAN PAPER
;TAPE BECAUSE ITS BYTE SIZE WILL PRESUMABLY BE
;DIFFERENT WHEN IT IS DEFINED FOR OTHER DEVICES.

;IF HERE, ALL SET EXCEPT SUBCOMMAND MAY HAVE SPECIFIED A BYTE SIZE
;ILLEGAL FOR DEVICE. CHECK FOR THAT.

COP3:	LDB B,[POINT 6,E,35]	;CHOSEN BYTE SIZE
	CAIE C,12
	CAIN D,12
	JRST [	CAIE B,7	;TTY TAKES 7 OR 8 ONLY
		CAIN B,10
		JRST .+1
		JRST COPDF1]	;TYPE MESSAGE AND DEFAULT
	CAIN D,7		;LPT TAKES 7 ONLY
	CAIN B,7
	JRST COP4		;ALL IS OK
	;...

;COPY/APPEND...
;DETERMINING MODE-BYTESIZE...   DEFAULT CASE...
;NO ACCEPTABLE SUBCOMMAND GIVEN.
;DEFAULT MODE AND BYTE SIZE AS A FUNCTION OF DEVICES USED.
;MODE ALWAYS 0 AT PRESENT.

	;...
COPDF1:	TYPE < [Illegal mode subcommand being ignored]
>
COPDEF:	JUMPN D,.+3
	JUMPN C,.+2
		;DISK TO DISK USES SOURCE BYTE SIZE
	SKIPA E,F		;DISK SOURCE BYTE SIZE IS IN F
		;MOST OTHER CASES USE 0-36
	MOVEI E,^D36
		;IF TTY: OR LPT: INVOLVED, USE 0-7
	CAIE C,12
	CAIN D,12
	JRST .+2
	CAIN D,7
	JRST [	MOVEI E,7
		JRST COP4]

;COPY/APPEND...
;DETERMINING MODE-BYTESIZE...   DEFAULT CASE...
;SPECIAL CASES FOR PAPER TAPE
	CAIE C,4		;PTR
	JRST COPDF3
	CAIN D,5		;PTP
	JRST [	MOVEI E,^D8		;USES 0-8 TO DUPLICATE PAPER TAPE
		JRST COP4]
	HRRZ B,OUTDSG		;PTR TO OTHER DEVICES DEPENDS ON DEST EXT
	JRST COPDF4
COPDF3:	CAIE D,5		;PTP
	JRST COPDF6
	JUMPE C,[MOVE E,F		;DSK TO PTP
		CAIN F,7		;IF SC BYTE SIZE 7, USE IT, NO MESSAGE.
		JRST COP4
		CAIE F,10		;IF 8, USE IT, TYPE MESSAGE
		MOVEI E,^D36		;OTHERWISE ASSUME 36 AND TYPE MESSAGE
		JRST COPDF5]		;NOTE THAT CAN'T TRUST SIZE OF 36 IN
		;FILE BECAUSE OTHER SIZES CAN BECOME
		;36 IF FILE IS COPIED TO DTA AND BACK.
	HRRZ B,@INIFH1		;OTHER DEVICES TO PTP, DEPENDS ON SC EXT
COPDF4:		;ONE IS PAPER TAPE, OTHER ISN'T. USE 0-36 FOR FILES
		;WITH EXTENSION OF .REL OR .SAV, 0-7 FOR OTHERS.
		;TYPE MESSAGE.  JFN OF NON-PAPERTAPE DEVICE NOW IN B.
	MOVE A,CSBUFP
	HRROI A,1(A)		;BEGINNING OF NEXT WORD OF STRING BUFFER
	SETZM (A)
	PUSH P,C
	HRLZI C,B11
	JFNS
	POP P,C
	MOVE A,CSBUFP
	MOVE A,1(A)		;FIRST WORD OF EXTENSION STRING
	CAME A,[ASCIZ /REL/]
	CAMN A,[ASCIZ /SAV/]
	JRST .+2		;REL OR SAV, USE 36 (ALREADY IN E)
	MOVEI E,7		;OTHER EXT OR NON-DIR DEVICE, USE 0-7
		;A MARGINAL ASSUMPTION HAS BEEN MADE ABOUT PAPER TAPE,
		;TYPE EXPLANATORY MESSAGE.
COPDF5:	TYPE < [>
	CAIN E,7
	TYPE <Ascii>
	CAIN E,10
	TYPE <Image>
	CAIN E,44
	TYPE <Binary>
	TYPE < mode assumed.]
>
		;JRST COP4
COPDF6:		;ADD CASES TO THE DEFAULTING STUFF HEHE
COP4:		;NOW HAVE MODES AND BYTE SIZE IN E

;COPY/APPEND...
;HAVE FINISHED CHOOSING MODE-BYTESIZE.
;OPEN FILES NOW, SO FFUFP WILL WORK.
		;SOURCE
	MOVEI B,1B19		;READ BIT FOR OPENF
	LDB A,[POINT 6,E,23]		;GET READ MODE FROM E
	DPB A,[POINT 4,B,9]
	LDB A,[POINT 6,E,35]		;BYTE SIZE
	DPB A,[POINT 6,B,5]
	HRRZ A,@INIFH1		;JFN
	CALL $OPENF		;OPENF WITH CHECK FOR PRI IO FILES 
		;AND FANCY ERROR MESSAGES
		;DESTINATION
	HRRZ A,OUTDSG
	GTSTS
	JUMPGE B,COP5A
		;DEST ALREADY OPEN, ITS ANOTHER COPY IN GROUP, SEE IF
		;MODE-BYTESIZE CONSISTENT, CHANGE WHERE POSSIBLE
	TLO Z,F3		;SAY IT WAS ALREADY OPEN
	MOVE B,E		;MODES-BYTESIZE CHOSEN FOR THIS COPY
	XOR B,AA		;COMPARE TO THOSE USED FOR LAST COPY
	TRNN B,7777		;OUTPUT MODE & SIZE THE SAME?
	JRST COP5B		;YES, ALL IS OK
	JUMPN D,.+2		;IF DEST NOT DSK, CHANGE ILLEGAL
	TRNE B,7700		;FOR DSK SIZE CAN CHANGE BUT MODE CAN'T
	ERROR <Illegal mode or byte size change,
 multiple-source copy cannot proceed>
	LDB B,[POINT 6,E,35]
	SFBSZ
	JRST COP5B
	JRST COP5B		;RET +2 OBSERVED 12/18/70 ______
COP5A:		;DEST WASN'T OPEN (NORMAL CASE), OPEN IT
	TLZ Z,F3		;SAY JUST OPENED (HENCE PAGE COPY OK)
	MOVEI B,1B20		;"WRITE" BIT FOR OPENF
	TLNE Z,F2		;SKIP IF "COPY" NOT "APPEND"
	MOVEI B,1B22		;"APPEND" BIT FOR OPENF
	LDB A,[POINT 6,E,29]		;GET WRITE MODE FROM E
	DPB A,[POINT 4,B,9]
	LDB A,[POINT 6,E,35]		;BYTE SIZE
	DPB A,[POINT 6,B,5]
	HRRZ A,OUTDSG		;JFN
	CALL $OPENF
COP5B:	MOVE AA,E		;SAVE MODE AND BYTE SIZE (NEEDED IF ANOTHER
		;COPY TO SAME FILE OCCURS IN GROUP)

;COPY/APPEND...
;HAVE ESTABLISHED MODE-BYTESIZE AND OPENED FILES.
;NOW DECIDE WHETHER A COPY WITH DISK SOURCE IS TO BE DONE BY BYTES
;OR PAGES (SET F1 FOR PAGES), BECAUSE BYTES CASE REQUIRES SPECIAL
;CHECKS BELOW.
	TLZ Z,F1		;SAY BYTES FOR NOW
	JUMPN C,COP6Z		;NON-DISC SOURCE, NO SPECIAL CHECK
	TLNN Z,F2+F3		;"APPEND" COMMAND AND OUTFILE ALREADY OPEN
		;(GROUP CASE) CAUSE BYTE COPYING
	JUMPE D,[		;NON-DISK DEST ALWAYS REQUIRES BYTE COPY.
		;BUT IF HERE, DEST IS ALSO DISK, CAN COPY BY
		;PAGES.
		TRNN Z,177777	;DON'T CPY BY PAGES IF MODES SPECIFIED
		TLO Z,F1		;SAY COPY BY PAGES
		JRST COP6Z]		;SKIP SPECIAL CHECK

;COPY/APPEND...
;SPECIAL WARNING CHECKS FOR COPYING/APPENDING FROM DSK BY BYTES.
;(OTHER CASES BRANCHED AROUND THIS CODE ABOVE.)
;CHECK FOR HOLES NOT BEYOND EOF AND ANY PAGES BEYOND EOF IN SOURCE FILE
; AND TYPE WARNING MESSAGES IF FOUND.
	PUSH P,C
	PUSH P,D
		;GET PAGE # OF LAST DATA BYTE INTO B
	HRRZ A,@INIFH1
	SIZEF		;BYTE # OF EOF INTO B
	 CALL JERR
	SUBI B,1		;CONVERT BYTE # OF EOF TO BYTE # LAST DATA BYTE
	JUMPL B,COP6C		;IF IT WAS 0, ITS NOW -1, WHICH IS PAGE #.
	MOVEI C,^D36
	IDIV C,F		;36 / BYTESIZE = # BYTES PER WORD
	IDIV B,C		;BYTE # / THAT   MAKES IT WORD #
	IDIVI B,1000		;MAKE IT PAGE # OF LAST DATA BYTE
COP6C:		;TEST FOR FIRST FREE PAGE NOT BEING AFTER LAST DATA BYTE'S PAGE
	HRRZ A,@INIFH1
	FFFFP		;FIND FIRST FREE FILE PAGE
	CAMN A,[-1]
	JRST .+3		;NO FREE PAGES IN FILE
	CAIL B,(A)
	TYPE < [Holes in file]
>
		;CHECK FOR USED PAGES AFTER LAST DATA BYTE PAGE
	HRL A,@INIFH1
	HRR A,B		;LAST DATA BYTE'S PAGE
	CALL $FNUFP		;INCREMENT A AND FIND NEXT USED PAGE
	JUMPE A,.+2		;0 RETURNED MEANS NO USED PAGE
	TYPE < [Pages after EOF will not be copied]
>
	POP P,D
	POP P,C
COP6Z:

;COPY/APPEND...
;IF WE WISH TO CONFIRM EACH COPY IN GROUP, HERE IS WHERE TO DO IT.

;NOW, AT LAST, WE ARE READY TO COPY. WELL, ALMOST.
;THERE ARE 5 CASES: 
; DISK TO DISK,
;	DONE BY PAGES, REPRODUCING "HOLES" AND PAGES AFTER BYTE EOF
; TTY TO ANYTHING, TERMINATED BY ^Z
; DISK TO OTHER DEVICE OR DISK-DISK FOR APPEND OR OUTFILE ALREADY OPEN,
;	PAGE READ AND BYTE WRITE.
; OTHER DEVICE TO DISK, USUALLY BYTE READ AND PAGE WRITE.
; ANY OTHER COMBINATION, DONE ENTIRELY BY BYTES.

		;COMPUTE NEGATIVE NUMBER OF BYTES PER PAGE INTO BB
		;(DONE NOW CAUSE CAN CLOBBER CC)
	MOVEI BB,^D36		;# BITS PER WORD
	LDB CC,[POINT 6,E,35]		;# BITS PER BYTE
	IDIV BB,CC		;FORM # BYTES PER WORD
	IMUL BB,[-1000]		;FORM - # BYTES PER PAGE
		;GET DISK SOURCE BYTE EOF IN CC
	HRRZ A,@INIFH1
	JUMPN C,COP7A
	PUSH P,C
	PUSH P,D
	SIZEF		;GETS BYTE # OF EOF IN FILE'S BYTESIZE INTO B
	 CALL JERR
		;TRANSLATE FROM BYTE SIZE OF FILE TO BYTE SIZE OF COPY.
		;NEW PTR = (OLD PTR*(36/NEW BYTE SIZE))/(36/OLD BYTE SIZE)
		; WITH ALL DIVISIONS INTEGER AND OUTERMOST ONE ROUNDED UP
	MOVEI C,^D36
	IDIV C,F		;F: SOURCE FILE (OLD) BYTE SIZE
	MOVE CC,C
	MOVEI C,^D36
	LDB D,[POINT 6,E,35]		;COPY (NEW) BYTE SIZE
	IDIV C,D
	MUL B,C
	DIV B,CC
	JUMPE C,.+2		;REMAINDER 0 ?
	ADDI B,1		;NO, ROUND UP.
	MOVE CC,B		;BYTE # OF EOF IN COPY BYTE SIZE
	POP P,D
	POP P,C
COP7A:
	TLNE Z,F1		;COPY BY PAGES FLAG ON?
	JRST PAGES		;YES, GO COPY BY PAGES

;COPY/APPEND...  DISPATCHING TO VARIOUS EXECUTION CASES...
;COPY BY BYTES OR A COMBINATION OF BYTES AND PAGES.
		;HRRZ A,@INIFH1	;ONE JFN IN A
	HRRZ F,OUTDSG		;OTHER ALWAYS IN F
		;GENERATE POINTER TO BUFFER W PROPER BYTE SIZE IN G
	MOVE G,[440000,,BUF1]		;P FIELD AND ADDRESS
	DPB E,[POINT 6,G,11]		;BYTE SIZE = S FIELD
		;NOW DISPATCH TO THE VARIOUS CASES
	CAIN C,12		;SOURCE TTY: ?
	JRST COPTTY		;YES, SPECIAL CODE TO END ON ^Z.
	JUMPE C,CPGBYT		;JUMP IF SOURCE DISK
	JUMPE D,[		;JUMP IF DEST DISK
		TLNE Z,F2+F3	;PG OUTPUT OK IF NOT "APPEND" AND
		JRST .+1	;OUTFILE WASN'T ALREADY OPEN (GROUP)
		JRST CBYTPG]		;USE PAGES TO WRITE ON DISK
	JRST COPBY		;ALL OTHER CASES

;COPY BY BYTES WITH TELETYPE SOURCE
;DO BYTE BY BYTE, WATCHING FOR ^Z TERMINATOR

COPTTY:	MOVEI B,CTTEOF		;WHERE TO GO ON EOF PSI
	MOVEM B,EOFDSP		;(DON'T THINK IT CAN OCCUR 11/20/70)
COPTT1:	BIN
	CAIN B,CTRLZ
CTTEOF:	JRST [	PRINT EOL		;IN CASE SOURCE IS CONTROLLING TTY
		JRST CBYEF1]		;GO DELETE EXTRA PAGES IF DEST IS DSK
	EXCH A,F
	BOUT
	EXCH A,F
	JRST COPTT1

;COPY/APPEND...
;COPY/APPEND BY BYTES, NON-TTY-SOURCE CASE
;USE FULL PAGE SINS AND SOUTS FOR SPEED.

COPBY:	MOVEI B,CBYEOF
	MOVEM B,EOFDSP		;WHERE TO GO ON EOF PSI
COPB1:	MOVE B,G		;BYTE PTR
	MOVE C,BB		;BYTE COUNT, NEG FOR NO SPECIAL TERM CHARACTER
	SIN		;INPUT A STRING (JFN ALL SET IN A)
		;SIN CAUSES EOF PSI AFTER READING WHATEVER CHARACTERS
		;THERE ARE IF NOT A WHOLE "COUNT"'S WORTH LEFT IN FILE
	EXCH A,F		;GET DESTINATION JFN, SAVE SOURCE JFN
	MOVE B,G		;BYTE PTR AGAIN
	MOVE C,BB		;SAME COUNT
	SOUT		;OUTPUT STRING
	EXCH A,F		;BACK TO SOURCE JFN
	JRST COPB1		;LOOP TILL EOF PSI

;EOF PSI WHILE COPYING BY BYTES (NON-TTY CASE)
;OUTPUT PARTIAL STRING INPUT BEFORE EOF OCCURRED
; (NOTE THAT C IS UPDATED TO REFLECT THOSE BYTES WHICH WERE READ)

CBYEOF:	EXCH A,F		;GET DEST JFN
	MOVE B,G		;THAT GOOD OLD BYTE PTR
	SUBM BB,C		;CREATE COUNT IN C OF CHARS THAT WERE INPUT
	JUMPE C,.+2		;0 COUNT, NO SOUT!
	SOUT		;OUTPUT THE LAST PART
;IF DESTINATION WAS DISK, DELETE ANY ADDITIONAL PAGES
; (CLOSF DOES NOT DO THIS, BUT WILL LATER ZERO REST OF LAST PAGE).
;TTY CASE JOINS HERE.

CBYEF1:	HRRZ A,OUTDSG
	DVCHR
	LDB A,[POINT 9,B,17]		;DEVICE TYPE 0 IS DSK
	JUMPN A,COPEOF		;IF NOT DISK, DONE HERE
	LDB D,[POINT 6,E,35]		;GET BYTE SIZE USED IN COPYING
	HRRZ A,OUTDSG
	RFPTR		;GETS BYTE # OF LAST DATA BYTE IN B
	 CALL JERR
	MOVEI C,^D36
	IDIV C,D		;36/BYTESIZE = # BYTES PER WORD
	IDIV B,C		;BYTE # /THAT = WORD # OF LAST DATA BYTE
	IDIVI B,1000		;MAKE IT PAGE #
	HRR A,B
	HRL A,OUTDSG
CBYEF2:	CALL $FNUFP		;FIND A PAGE
	JUMPE A,COPEOF		;NO MORE PAGES IN FILE, DONE
	MOVE B,A
	SETO A,
	HRLZI C,1
	PMAP		;DELETE THE PAGE
	MOVE A,B
	JRST CBYEF2

;COPY/APPEND...
;COPY FROM DISK, READING BY PAGES AND WRITING BY BYTES.
;TRANSFERS ZEROS FOR HOLES OR BEYOND BYTE EOF.
;ADDED TO SPEED UP DISK TO LPT COPY.
;AT ENTRY: A,F: JFNS
;	G: BYTE PTR TO BUFFER PAGE
;	BB: - # BYTES / PAGE
;	CC: BYTE # OF EOF
;ALSO:	A: SOURCE JFN,,PAGE #

CPGBYT:	HRLZ A,@INIFH1
CPGBY2:	RPACS
	TLNN 2,(1B5)		;PAGE EXISTS?
	JRST .+4		;NO, DON'T MAP IT
	MOVE B,[B0,,<BUF1>B44]
	HRLZI C,B2+1
	PMAP		;MAP IN THE PAGE
;HAVE A PAGE IN SOURCE FILE, DECIDE WHAT TO DO WITH IT BY
;COMPARING PAGE # AND FILE'S BYTE EOF
	HRRZ C,A		;PAGE #
	IMUL C,BB		; - BYTE # OF FIRST BYTE IN PAGE
	ADD C,CC		;CC: BYTE # OF EOF
	MOVN C,C		;FORM - # BYTES IN OR BEYOND THIS PAGE
	JUMPGE C,CPBEOF		;NONE, DONE.
;TRANSFER PARTIAL PAGE IF THIS IS EOF PAGE, ELSE WHOLE PAGE.
	CAMGE C,BB		;- # BYTES/PAGE
	MOVE C,BB		;MAXIMUM TRANSFER
	RPACS
	TLNN 2,(1B5)		;PAGE EXISTS?
	JRST CPGBY4		;NO, USE ZEROS
;OUTPUT # BYTES IN C
	EXCH A,F		;GET DEST JFN
	MOVE B,G		;STRING PTR TO BUFFER
	SOUT		;STRING OUTPUT
CPGBY3:	EXCH A,F
	AOJA A,CPGBY2		;DO NEXT PAGE

CPGBY4:	EXCH A,F
	SETZ 2,
	BOUT			;DO PAGE WORTH OF ZEROS
	AOJL C,.-1
	JRST CPGBY3

;COPY BY PAGES-BYTES EOF. CLEAR BUFFER.

CPBEOF:	SETO A,
	MOVE B,[B0,,<BUF1>B44]
	HRLZI C,1
	PMAP
	JRST COPEOF

;COPY/APPEND...
;COPY NON-DISK TO DISK IN NON-APPEND, NON MULTIPLE SOURCE CASE.
;USES BYTES FOR INPUT, PAGES FOR OUTPUT.
;ADDL ACS: F: DEST JFN,,PAGE #
;	CC: # BYTES TRANSFERRED+1, USED TO SET DEST EOF PTR.

CBYTPG:	HRLZ F,OUTDSG
	MOVEI B,CBPGEF
	MOVEM B,EOFDSP		;WHERE TO GO ON EOF
	SETZ CC,
CBYPG2:	SETO A,		;CLEAR BUFFER AT TOP OF LOOP TO MAKE SURE
	MOVE B,[B0,,<BUF1>B44]		;...OF EOF PAGE IS 0
	HRLZI C,1
	PMAP
	HRRZ A,@INIFH1
	MOVE B,G
	MOVE C,BB		;NEG # BYTES/PAGE
	SUB CC,C		;COUNT BYTES TRANSFERRED
	SIN		;READ A PAGE'S WORTH OF BYTES
	MOVE B,F
	MOVE A,[B0,,<BUF1>B44]
	HRLZI C,B3+1
	PMAP		;MAP OUT THE PAGE
	AOJA F,CBYPG2		;NEXT PAGE AND LOOP

;BYTES-PAGES END OF FILE

CBPGEF:	ADD CC,C		;ADJUST FOR UNUSED PART OF BYTE COUNT
	CAMN C,BB		;WHOLE PAGE UNUSED?
	SKIPA A,[-1]		;YES, PUT NO PAGE IN DESTINATION
	MOVE A,[B0,,<BUF1>B44]
CBPEF3:	MOVE B,F
	HRLZI C,B3+1
	PMAP		;MAP OUT LAST PAGE OR DELETE PAGE
;FAKE THINGS UP AND ENTER PAGES-PAGES ROUTINE TO DELETE RESET OF DEST
;AND SET EOF AND BYTE SIZE
	SETZ D,		;SAYS NO MORE SOURCE "PAGES"
	JRST PAGE5A

;COPY/APPEND...
;COPY DISK TO DISK BY PAGES
;NOTE THAT BYTE SIZE IN E MUST BE PRESERVED

PAGES:	HRLZ D,@INIFH1		;D: SOURCE JFN,,PAGE #
	HRLZ F,OUTDSG		;F: DEST JFN,,PAGE #
		;D AND F ARE SET TO 0 AFTER ALL PAGES IN FILE ARE USED
;GET FIRST PAGE IN EACH FILE
	MOVE A,D
	CALL $FFUFP
	MOVE D,A
	MOVE A,F
	CALL $FFUFP
	MOVE F,A
;HAVE A PAGE IN EACH FILE. DECIDE WHAT TO DO WITH THEM.

PAGES3:	JUMPE F,[;NO MORE PAGES IN DEST
		JUMPE D,PAGES9		;ALSO NO MORE IN SOURCE, DONE.
		JRST PAGES5]		;GO COPY PAGE
	JUMPE D,PAGES4		;NO MORE PAGES IN SOURCE, DELETE REST OF DEST
	MOVEI A,(D)
	CAIG A,(F)		;COMPARE SOURCE PAGE # TO DEST PAGE #
	JRST PAGES5
;DELETE DEST PAGES CORRESPONDING TO "HOLE" IN SOURCE

PAGES4:	SETO A,
	MOVE B,F
	HRLZI C,1		;PMAP DISPOSAL INFO
	PMAP
	MOVE A,F
	CALL $FNUFP		;NEXT PAGE IN DEST
	MOVE F,A
	JRST PAGES3		;GO DECIDE AGAIN

;COPY/APPEND...
;COPY BY PAGES...
;COPY A PAGE

PAGES5:	MOVE A,D		;SOURCE JFN AND PAGE NUMBER
	MOVE B,[B0,,<BUF1>B44]
	HRLZI C,B2+1
	PMAP		;MAP SOURCE PAGE INTO BUFFER
	HRL A,OUTDSG		;DON'T USE F HERE, MAY BE 0!
	HRRI B,<BUF2>B44
	HRLZI C,B3+1
	PMAP		;MAP DESTINATION PAGE INTO ANOTHER BUFFER
	MOVE A,[BUF1,,BUF2]
	BLT A,BUF2+777		;COPY DATA
	MOVEI A,(D)		;MASK PAGE # OF PAGE JUST COPIED
	CAIGE A,(F)		;COMPARE TO DEST PAGE #
	JRST PAGES6		;PAGE WAS COPIED INTO A HOLE IN DEST
;COPY BY BYTES-PAGES COMES HERE AFTER EOF WITH D 0 AND BB,CC,F CORRECT
; TO DELETE REST OF DEST FILE AND SET ITS PTR AND BYTE SIZE.

PAGE5A:	MOVE A,F
	CALL $FNUFP		;NEXT PAGE IN DEST
	MOVE F,A
PAGES6:	MOVE A,D
	CALL $FNUFP		;ALWAYS NEXT PAGE IN SOURCE
	MOVE D,A
	JRST PAGES3

;COPY/APPEND...
;FINISH UP COPY BY PAGES.
;ALSO USED FOR BYTES-PAGES, SO NOTHING DISK-DEPENDENT CAN BE DONE HERE.

PAGES9:	SETO A,		;CLEAR BUFFERS
	MOVE B,[B0,,<BUF1>B44]
	HRLZI C,1
	PMAP
	HRRI B,<BUF2>B44
	PMAP
;SET END POINTER OF DESTINATION FILE
	MOVE B,CC		;BYTE COUNT OF SOURCE EOF
	HRRZ A,OUTDSG		;SET POINTER FOR THIS OPENING OF FILE, IN CASE
	SFPTR		;SEQUENTIAL I/O FOLLOWS (GROUP SOURCE CASE)
	 CALL JERR
	HRLI A,FDBSIZ		;SET EOF PTR IN FILE (CLOSF DOES NOT WHEN
	MOVE C,B		;NO SEQUENTIAL OUTPUT HAS BEEN DONE)
	SETO B,
	CHFDB		;CHANGE FILE DESCRIPTOR BLOCK
;SET BYTE SIZE OF DESTINATION FILE
;(CLOSF DOES NOT SET IT WHEN NO SEQUENTIAL OUTPUT HAS BEEN DONE)
		;MOVE A,OUTDSG
	HRLI A,FDBBYV
	SETZ C,
	DPB E,[POINT 6,C,11]		;BYTE SIZE STILL IN E
	MOVSI B,(77B11)
	CHFDB

;COPY OR APPEND COMPLETE.
;PAGE-COPY FALLS IN, ALL OTHER CASES BRANCH HERE.

COPEOF:	SETZM EOFDSP		;(REDUNDANT EXCEPT IN ^Z ON TTY CASE)
	CALL GNFIL		;GET NEXT FILE IN INPUT GROUP
	JRST [	CALL RLJFNS		;NO MORE FILES, RELEASE JFNS
		JRST CMDIN4]		;GO BACK TO COMMAND INPUT LOOP
	JRST COPFL

;COPY/APPEND...
;SUBROUTINE TO GET NEXT USED PAGE # OF DISK FILE.
;TAKES IN A:  JFN,,CURRENT PAGE #.  RETURNS A 0 IF NO MORE PAGES.
;MUST BE NEAR COPY TO MINIMIZE PAGE FAULTS

$FNUFP:	JUMPE A,[RET]		;ALREADY AT END, NOP.
	ADDI A,1		;NEXT PAGE NUMBER
	TRNN A,-1
	JRST [	SETZ A,		;WRAP-AROUND FROM MAX PAGE NUMBER
		RET]
;ENTRY TO GET FIRST USED PAGE NUMBER. DOESN'T INCREMENT FIRST.

$FFUFP:	FFUFP
	 CALL [	CAIE A,FFUFX3		;"NO MORE PAGES" ERROR?
		JRST JERR
		SETZ A,
		RET]
	RET

;COPY/APPEND SUBCOMMAND TABLE AND ROUTINES

$COPY:	TABLE
	TE ASCII
	TE BCD,,ONEWD+INVIS,NIYE
	TE BINARY,,ONEWD
	T BYTE,,LPROK+INVIS
	TE DUMP,,ONEWD+INVIS,NIYE
	TE IMAGE
	T RECORD,,LPROK+INVIS
	TEND

.ASCII:	KEYWD $ASCII
	 TE ,,,2
	 JRST CERR
ASCII1:	CONFIRM
	TRNE KWV,B0
     TYPE < ["Ascii parity" not implemented yet, will treat as "Ascii"]
>
	HRR Z,KWV		;NEW FLAGS FROM TABLE ENTRY
	RET

$ASCII:	TABLE
	TE PARITY,,,B0+2		;B0: PARITY CHECK. 2: ASCII MODE
	TEND

.BINAR:	HRRI Z,10000		;"BINARY" MODE BIT (MODE 14)
	RET

.BYTE:	NOISE (size)
	CALL DECIN
	JRST CERR
	CONFIRM
	MOVEI E,0(A)		;BYTE SIZE GOES IN E WITH MODES 0
	TRO Z,1			;SAY MODE 0
	RET

.IMAGE:	KEYWD $IMAGE
	 TE ,,,400
	 JRST CERR
	JRST ASCII1

$IMAGE:	TABLE
	TE BINARY,,,4000
	TEND

.RECOR:	NOISE (length)
	JRST NIYE

;OPEN FILE SUBROUTINE
;DOES OPENF, RETURNS ON SUCCESS, GIVES MESSAGE ON FAILURE
;CALL WITH A & B SET UP FOR "OPENF" JSYS.
;CHECKS FOR AND DOES NOT RE-OPEN PRI I/O FILES
; (PRI FILES ARE SOMETIMES DEFAULT ARG VALUES).

$OPEN7:	HRLI B,<7B5+0B9>B53	;ENTER HERE FOR 7 BIT BYTES NORMAL MODE
$OPENF:	CAME A,CIJFN		;REGULAR ENTRY
	CAMN A,COJFN
	RET			;DON'T TRY TO OPEN PRI FILES AGAIN
	PUSH P,A		;SAVE JFN FOR USE IN ERROR MESSAGE
	OPENF			;OPEN FILE
	 CALL $OPNER		;ERROR, # IN A, SAVE PC FOR JERR.
	POP P,A			;SUCCESS, RETURN TO CALLER.
	RET

$OPNER:	CAIN A,OPNX9
	JRST [	SUB P,BHC+1	;Flush error PC
		POP P,A		;Retrieve JFN
		TRNN B,1B18!1B20!1B21!1B22!1B23!1B24 ;Not read only open?
		TROE B,1B25	; or have already tried thawed?
		 ERROR <File %1S busy> ;Yes, announce error
		JRST $OPENF]	;Try in thawed mode
	MOVE C,-1(P)		;RETRIEVE JFN FOR %S
	CAIN A,OPNX13
	 ERROR <Access to %3S denied>
	CAIN A,OPNX3
	ERROR <Read protect violation for file %3S>
	CAIN A,OPNX4
	ERROR <Write protect violation for file %3S>
	CAIN A,OPNX6
	ERROR <Can't append to file %3S>
	CAIN A,OPNX7
	JRST [	MOVE A,C
		DVCHR
		PUSH P,A
		PUSH P,C
		CAIE C,-1	;Unassigned?
		ERROR <%1H: is assigned to job %3Q>
		MOVE A,['TTYJOB']
		CALL $SYSGT
		POP P,A		;Pop back -1,,unit number
		HRLZS A		;TTY number to left half
		HRR A,B		;Table number
		GETAB
		 CALL JERR
		HLRZ C,A	;Job number
		POP P,A		;Device designator
		ERROR <%1H: is the controlling terminal for job %3Q>
		]
	CAIN A,OPNX8
	ERROR <%3H: not mounted>
	CAIN A,OPNX10
	ERROR <No room in system for another open file>
	JRST JERR		;GO TO GENERAL JSYS ERROR ROUTINE


;LIST/TYPE <FILE GROUP DESCRIPTOR>

;FLAGS USED, IN AC F
;B0  "PRINTER WATCH ON"
;B1  SITE INCLUDED IN HEADING
;B2  INDICATE NULLS BY ^@
;B3  NO PAGE NUMBERS
;B4  SUPPRESS PRINTING/CHARACTER POSITION ACCOUNTING (SKIPPING PAGES)
;B5  LAST LINE SCANNED WAS COMMENT
;B6  LAST LINE SCANNED WAS NOT COMMENT
;B7  LAST CHAR LF OR EOL AND SPACING GREATER THAN 1
;B8  LAST CHAR WAS LINE OVERFLOW EOL
;B9  LAST CHAR WAS CONTROL CHAR TO INDICATE WITH ^X (LOCAL TO GETC)
;B10 SUPPRESS PRINTING (WHEN PASSING EOLS & ^LS AT BOTTOM OF PAGE)
;B11 EOF HAS BEEN ENCOUNTERED IN INPUTTING TO INPUT BUFFER
;B12 EOF HAS BEEN ENCOUNTERED IN READING FROM INPUT BUFFER
;B13 LAST CHR WAS EOL, OUTPUT AN LF THIS TIME
;B14 PAUSE BEFORE EACH PAGE
;B15 SOURCE IS TTY, TERMINATE ON ^Z
;B16 DETACH BEFORE LISTING
;B17 LOGOUT AFTER LISTING
;B18 VERBATIM FILE OUTPUT, NO CONTROL CHARACTER INDICATION
;B19 SET WHEN ANY DATA IS REALLY WRITTEN INTO THE FILE

;LIST/TYPE...   STORAGE

;IN XPRIV.MAC:
;GHEAD		0 OR BYTE POINTER TO SUBCOMMAND-GIVEN HEADING
;HEAD		0 OR PTR TO HEAD BEING USED FOR THIS FILE, INCL "PAGE "
;HEDLNO		# LINES IN HEADING, INCL EOLS BEFORE AND AFTER
;SPCG		0 FOR SINGLE SPACING, 1 FOR DOUBLE, ETC
;WIDTH		PAGE WIDTH IN COLUMNS
;LENGTH		PAGE LENGTH IN LINES
		; = LAST LINE AT WHICH TO BREAK PAGE IF NO ^L
;L35		FIRST LINE AT WHICH TO BREAK PAGE IN ABSENCE OF ^L
;L50		PREFERRED LINE AT WHICH TO BREAK PAGE
;PAGENO		PAGE NUMBER, INCREMENTED AT ^L
;PAGEN1		SUBPAGE NUMBER, INCREMENTED WHEN OVERLONG PAGE IS SPLIT
;BESPTR		POINTER TO BEST PLACE IN OUTBUF YET SEEN TO BREAK PAGE
;BESCOR		"SCORE" ASSOCIATED WITH BESPTR
;BESLNO		LINE # AT BESPTR
;PPRINT		POINTER TO BLOCK OF WORDS SPECIFYING PAGES TO LIST,
		;EACH WORD BEING MIN,,MAX, 0 TERMINATING BLOCK.

;THE PAGE BUF1 (DEFINED IN XDEF.MAC) IS INPUT BUFFER
INBUF==BUF1
INBUFL==<BUF1+1000-INBUF>*5-1		;LENGTH, LEAVING SPACE FOR NULL

;OUTPUT BUFFER IS BUF2 AND FOLLOWING PAGES

;AC'S
;CHR (DEFINED IN XDEF)		;CHARACTER READ FROM INBUF
;CNO AND LNO SPECIFY POSITION ON PAGE OF LAST CHARACTER IN OUTBUF
CNO==BB		;COLUMN NUMBER ON LINE
LNO==CC		;LINE NUMBER ON PAGE
INPTR==DD		;BYTE PTR TO INPUT BUFFER
OUTPTR==EE		;BYTE PTR TO OUTPUT BUFFER
;CNT (DEFINED IN XDEF)		;NUMBER OF CHARACTERS REMAINING IN INBUF
GBGPCT==^D20		;PERCENT CONTROL CHARACTERS IN FIRST PAGE OF
			;FILE ABOVE WHICH THE FILE IS CONSIDERED TO
			;BE GARBAGE.

;LIST/TYPE

.TYPE:	MOVE A,COJFN
	MOVEM A,OUTDSG
	JRST LIST1

.LIST:	CALL $LPT		;USE A "DIRECTORY" SUBCOMMAND ROUTINE TO
				;ASSIGN A JFN TO LINE PRINTER
LIST1:	NOISE (file)
	SETZ F,			;CLEAR FLAGS
	SETZM GHEAD
	SETZM SPCG
	SETOM LENGTH		;INDICATE LENGTH UNSPECIFIED
	SETOM WIDTH		;INDICATE WIDTH UNSPECIFIED
	SETOM	SPCBTS		;INIT CONTROL-CHAR WORD TO ALL SPACING
				;IF VERBATIM
	MOVEI A,[1,,777777
		0]
	MOVEM A,PPRINT
	CALL $INFG		;INPUT FILE GROUP
	JRST [		;R1: SUBCOMMANDS REQUIRED
		CONFIRM
		SUBCOM $LIST
		JRST .+2]
	CONFIRM

;LIST/TYPE...   PRE-FIRST-FILE INITIALIZATION

;OPEN OUTPUT FILE
	MOVE A,OUTDSG
	MOVEI B,1B20
	CALL $OPEN7
;NOW THAT "[LPT: BUSY-GO]" HAS BEEN PRINTED,
;DETACH IF REQUESTED BY SUBCOMMAND
	TLNN F,B16
	JRST LIST1D
	ETYPE < Detaching job %J
>;
	DTACH
LIST1D:	CALL LPTCHK		;CHECK FOR LINEPRINTER
	 JRST [	MOVEI A,LPTWID
		MOVEI B,LPTLEN
		JRST LIST1E]
;USE ACTUAL LENGTH AND WIDTH OF OUTPUT DEVICE IF NOT SPECIFIED
; BY USER WITH "LENGTH" AND "WIDTH" SUBCOMMANDS
	MOVE A,OUTDSG
	RFMOD
	LDB A,[POINT 7,B,17]	;GET WIDTH
	CAIGE A,^D15		;REASONABLE (LESS SCREWS TITLE SETUP)
NOIAC <	MOVEI A,377777		;NO. 0 MEANS INFINITY (NO FOLDING) >
IAC <	MOVEI	A,LPTWID	; WE'LL USE LPT WIDTH AT IAC >
	LDB B,[POINT 7,B,10]	;GET OUTPUT DEVICE PAGE LENGTH
	CAIGE B,^D10		;REASONABLE?
	MOVEI B,^D66		;NO, USE COMMON DEFAULT
	IMULI B,^D10		;LEAVE 1/10 PAGE LENGTH FOR MARGINS
	IDIVI B,^D11
LIST1E:	SKIPGE WIDTH		;SKIP IF SPECIFIED BY SUBCOMMAND
	MOVEM A,WIDTH		;STORE DEVICE WIDTH
	SKIPGE LENGTH		;SKIP IF SPECIFIED BY SUBCOMMAND
	MOVEM B,LENGTH		;STORE PAGE LENGTH

;DETERMINE LINE "35"=FIRST LINE AT WHICH PAGE BREAK CAN OCCUR
	MOVE B,LENGTH		;PAGE LENGTH, PERHAPS CHANGED FROM 60
	IMULI B,^D8		;...BY SUBCOMMAND
	IDIVI B,^D12
	MOVEM B,L35
;DETERMINE LINE "50"=OPTIMUM PAGE BREAK POINT (NOW ACTUALLY 55)
	MOVE B,LENGTH
	IMULI B,^D11
	IDIVI B,^D12
	MOVEM B,L50
	JRST LSTFL		;JUMP AROUND SUBCMD STUFF


;LIST/TYPE SUBCOMMAND TABLE AND ROUTINES

$LIST:	TABLE
	TE DETACH,,LPROK,..DETA
	T DOUBLESPACE,,ONEWD+INVIS,..DOUB
	TE HEADING
	T INDICATE,,LPROK+EOLOK+ALTCON,..INDI
	T LENGTH,,,..LENG
	TE LOGOUT,,LPROK,...LOG
	TE NO,,LPROK,...NO
	T OUTPUT,,CONMAN+LPROK,..OUTP
	T PAGES
	TE PAUSE,,LPROK
	TE SITE,,LPROK,..SITE
	T SPACING
	T VERBATIM,,,...VRB
	TE WATCH,,,..WATC
	T WIDTH
	TEND

..DETA:	NOISE (before listing)
	CONFIRM
	TLO F,B16
	RET

..DOUB:	MOVEI A,1
	JRST SPAC2

;LIST/TYPE SUBCOMMANDS...

;HEADING: TAKE TEXT TO CR OR ALT MODE, COMMENT OK AFTER ALT MODE,
;CR TERMINATING "HEADING" MEANS NONE.
;CARRIAGE RETURNS CAN BE PUT IN HEADING WITH ^V OR &.

.HEADI:	MOVE A,[POINT 7,[0]]
	TRNE CBT,TEOL
	JRST [	CONFIRM
		JRST HEADI1]
	CALL CSTR
	CAIN TRM,FORMF
	JRST .+5
	CAIE CHR,EOL
	CAIN CHR,ALTM
	JRST .+2
	JRST MORE
	ALTYPE ( )
	CONFIRM
		;COPY TEXT TO CSBUF: CAN'T USE "BUFFF" CAUSE IT CHANGES CONTCH
		;TO SPACE, LOWER CASE TO UPPER, HAS LENGTH LIMIT.
	MOVE A,CSBUFP
	MOVE B,.BFP
	MOVE C,CNT
	SOJLE C,.+3
	ILDB D,B
	IDPB D,A
	SOJG C,.-2
	SETZ C,
	IDPB C,A
	EXCH A,CSBUFP
HEADI1:	MOVEM A,GHEAD
	RET

;LIST/TYPE SUBCOMMANDS...

..INDI:	UNOI [ASCIZ /nulls by ^@/]
	ALLOW  TSPC+TALT+TEOL
	CONFIRM
	TLO F,B2
	RET

..LENG:	NOISE (of page is)
	CALL DECIN
	 JRST CERR
	ALLOW TALT+TSPC+TEOL
	CAIG A,^D10
	JRST CERR
	CONFIRM
	MOVEM A,LENGTH
	RET

...LOG:	NOISE (after listing)
	CALL INFER
	JRST .+2
	ERROR <Not legal in inferior MFEXEC>
	CONFIRM
	TLO F,B17
	RET

...NO:	NOISE (page numbers)
	CONFIRM
	TLO F,B3
	RET

..OUTP:	NOISE (to file)
	MOVE A,[2,,[ASCIZ /LIST/]]		;DEFAULT: SOURCE NAME, .LIST
	CALL COUTFN
	 JRST CERR
	ALLOW TALT+TSPC+TEOL
	CONFIRM
	MOVEM A,OUTDSG
	RET

;LIST/TYPE SUBCOMMANDS...

;PAGES N,N-N,N-N,N...
;EACH NUMBER MUST BE GREATER THAN OR EQUAL TO LAST

.PAGES:	MOVEI D,1		;LARGEST NUMBER YET SEEN
	AOS B,CSBUFP		;BUILD BLOCK OF MIN,,MAX IN STRING BUFFER
PAGE1:	TLO Z,DASHF		;MAKES "-" A FIELD TERMINATOR
	CALL DECIN
	 JRST CERR
	CAIL A,(D)
	CAILE A,-1
	JRST CERR
	HRL C,A
	MOVE D,A
	CAIE TRM,"-"
	JRST PAGE2
	CALL DECIN
	 JRST CERR
	CAIL A,(D)
	CAILE A,-1
	JRST CERR
	MOVE D,A
PAGE2:	HRR C,A
	MOVEM C,(B)
	TRNE CBT,TCOM
	AOJA B,PAGE1
	ALLOW TALT+TSPC+TEOL
	TLZ Z,DASHF
	ALLOW TALT+TSPC+TEOL
	CONFIRM
	SETZM 1(B)		;0 ENDS BLOCK
	ADDI B,2
	EXCH B,CSBUFP
	HRRZM B,PPRINT
	RET

;LIST/TYPE SUBCOMMANDS...

.PAUSE:	NOISE (before each page)
	CONFIRM
	TLO F,B14
	RET

.SPACI:	CALL DECIN
	 JRST CERR
	ALLOW TALT+TSPC+TEOL
	SOJL A,CERR		;STORE SPACING - 1
	CAIL A,10
	JRST CERR
SPAC2:	CONFIRM
	MOVEM A,SPCG
	RET


..SITE:	NOISE (in heading)
	CONFIRM
	TLO F,(1B1)
	RET

;VERBATIM [SPACING/NON-SPACING [(CONTROL CHR CODES) NN, NN-NN, ... ]]

...VRB:	KEYWD $VRBTB
	 T SPACING,,LPROK+EOLOK,-1
	 JRST CERR
	TLO Z,DASHF		;MAKE "-" A FIELD TERMINATOR
	NOISE (control character codes)
	HRRE C,KWV		;EXTEND VALUE (0=NONSPACING, -1 SPACING)
	TLNN Z,BAKFF		;IF ALREADY BACKED UP OR
	TRNE CBT,TEOL		;ALREADY HAVE TERMINATOR
	 JRST .+3		;THEN DON'T READ MORE
	CALL CSTR		;INPUT NEXT FIELD
	TLO Z,BAKFF		;SIGNAL TO BACK UP OVER IT
	TLNE Z,BAKFF		;BACKED UP?
	CAIG CNT,1		;YES, EMPTY?
	TRNN CBT,TEOL		;AND TERMINATED BY CARRIAGE RETURN?
	CAIA			;NO, HAVE A FIELD TO INPUT
	 JRST VERBA4		;YES, SET BITS FOR ALL CODES
	SKIPE A,SPCBTS		;CHECK PREVIOUS SETTING -- ALL OFF/ON?
	AOSN A
	CAIA
	SKIPA C,SPCBTS		;NO, START WITH EXISTING SETTINGS
	 SETCM C,C		;YES, START WITH COMPL. OF NEW SETTINGS

VERBA1:	CALL OCTICC		;INPUT CHAR CODE, RETURN BIT IN A
	CAIE TRM,"-"		;GIVING RANGE?
	 JRST VERBA2		;NO, JUST SINGLE CODE
	SOS D,A			;YES, TURN ON ALL BITS FOLLOWING CODE
	CALL OCTICC		;GET END OF RANGE
	SUBI A,1		;TURN ON BITS FOLLOWING END OF RANGE
	CAMGE D,A		;ERROR IF END LT BEGINNING
	 JRST CERR
	LSH D,1			;OK, INCLUDE BEGINNING CODE IN RANGE
	ANDCA A,D		;CLEAR BITS FOLLOWING RANGE
VERBA2:	TRNE KWV,-1		;WHICH KEYWORD?
	TDOA C,A		;SPACING, SET BITS FOR SELECTED CODES
	TDZ C,A			;NON-SPACING, CLEAR BITS
	TRNE CBT,TCOM		;COMMA?
	 JRST VERBA1		;YES, BACK FOR MORE CODES
	TLZ Z,DASHF		;NO, RESET THIS FLAG
	ALLOW TALT+TSPC+TEOL
VERBA4:	CONFIRM
	MOVEM C,SPCBTS		;STORE NEW SETTING OF SPACING BITS
	TRO F,1B18		;SUPPRESS CONTROL INDICATON
	RET

$VRBTB:	TABLE
	T NON-SPACING,,LPROK+EOLOK,0
	T SPACING,,LPROK+EOLOK,-1
	TEND

;INPUT OCTAL CHARACTER CODE (0-37).
;RETURN IN A  A SINGLE BIT IN THE CORRESPONDING BIT POSITION.

OCTICC:	CALL OCTAL		;INPUT OCTAL NUMBER
	 JRST CERR
	CAIL A,0		;ONLY CONTROL CHARACTERS
	CAIL A,40
	 JRST CERR
	MOVN B,A		;OK NEGATE CODE
	MOVSI A,(1B0)
	LSH A,(B)		;SETBIT IN CORRESPONDING POSITION
	RET

..WATC:	NOISE (for printer completion)
	CONFIRM
	TLO F,(1B0)
	RET


.WIDTH:	CALL DECIN
	 JRST CERR
	ALLOW TALT+TSPC+TEOL
	CAIG A,^D15		;LESS SCREWS UP TITLE SETUP CODE
	JRST CERR
	CONFIRM
	MOVEM A,WIDTH
	RET

;LIST/TYPE...
;HERE TO LIST NEXT FILE IN LIST

LSTFL:	MOVE A,OUTDSG		;OUTPUTTING TO CONTROL TTY?
	CAME A,COJFN
	TLNE F,B16		;OR DETACHING?
	CAIA			;YES, DON'T TYPE FILENAME
	CALL TYPIF		;NO, TYPE FILENAME IF MULTIPLE
	TLZ F,B4+B5+B6+B7+B8+B9+B11+B12+B13+B15
;OPEN INPUT FILE
	HRRZ A,@INIFH1
	MOVEI B,1B19
	CALL $OPEN7
;SET ^Z FLAG IF TTY
	DVCHR
	LDB E,[POINT 9,B,17] ;DEVICE TYPE IN E USED FOR HEADING BELOW
	CAIN E,12
	TLO F,B15

;LIST/TYPE...  SET UP HEADING
	SETZ CNO,		;WILL BE USED TO ACCOUNT SPACES AND EOLS IN HEDG
	MOVEI LNO,1		;START # LINES AT 1 TO ALLOW FOR EOL BEFORE HEDG
	SKIPE INPTR,GHEAD
	JRST LSTH2		;HAVE SUBCOMMAND-GIVEN HEADING

;SET UP DEFAULT HEADING: FILE NAME AND DATE & TIME
	MOVE A,CSBUFP
	ADDI A,40		;ADD 40 CAUSE ITS WRITTEN OVER BELOW,
	MOVE INPTR,A		;INSERTED EOLS MAY CAUSE WIDTH OVERFLOW
	CALL COMCHR		;OUTPUT THE COMMENT CHARACTER
	MOVEI B," "
	BOUT
	BOUT
	TLNE F,(1B1)		;CHECK "SITE" BIT
	 CALL SITEO		;OUTPUT SITE ON A
	HRRZ B,@INIFH1
	MOVE C,[2B2+1B5+1B8+1B11+1B14+1]
	JFNS
	HRROI B,[ASCIZ /   /]
	SETZ C,
	SOUT
		;DATE: WRITE DATE OF DISC FILE TO WHICH WE HAVE LIST ACCESS,
		;ELSE CURRENT.
	SETO B,		;SAYS "CURRENT" TO ODTIM
	JUMPN E,LSTH1B		;JUMP IF NON-DISC
		;GET WRITE DATE
	PUSH P,A
	HRRZ A,@INIFH1
	MOVE B,[1,,FDBWRT]
	MOVEI C,B
	CALL $GTFDB		;DO GTFDB JSYS, NO SKIP IF NO ACCESS
	SETO B,		;NO ACCESS, USE CURRENT
	POP P,A
LSTH1B:	HRLZI C,B1+B10+B11+B17		;ODTIM FORMAT
	ODTIM
	SETZ CNT,		;BUT TELL "GETC" ITS INFINITELY SHORT
		; (ALSO BECAUSE ITS NULL TERMINATED)

;LIST/TYPE SETTING UP HEADING...

;SCAN HEADING STRING, COUNTING EOL'S (FOR EFFECT ON PAGE SIZE) AND
;COLUMNS USED (SO PAGE NUMBER CAN BE POSITIONED AT RIGHT).
;USE FAKED-UP CALLS TO FILE CHAR READER "GETC".
;"INPTR" NOW POINTS TO STRING.

LSTH2:	TLO F,B11
	MOVE OUTPTR,CSBUFP
	MOVEM OUTPTR,HEAD
	SETZ CNT,		;TELL GETC ITS TERMINATED BY FIRST NULL
LSTH2A:	CALL GETC		;READ CHARACTER
	CAIE CHR,CONTCH		;CHANGE CONTINUATION CHARACTER & TO CRLF
	JRST LSTH2D
	MOVEI B,CR
	DPB B,OUTPTR		;OVERWRITE THE "&"
	MOVEI B,LF
	IDPB B,OUTPTR
	SETZ CNO,
	MOVEI LNO,1(LNO)
LSTH2D:	CAIE CHR,200		;END OF STRING ?
	JRST LSTH2A
;SPACE OVER AND ADD " PAGE " IF PAGES ARE TO BE NUMBERED
	MOVE A,OUTPTR
	TLNE F,B3
	JRST LSTH4		;PAGE NUMBERS SUPPRESSED
	MOVE C,WIDTH
	SUBI C,^D14		;SPACE FOR "  PAGE NNN:NNN"
	SUB C,CNO
	CAILE C,^D128		;WIDTH IS INFINITY?
	MOVEI C,^D10		;YES, USE SOMETHING MORE MODEST
	JUMPLE C,[MOVEI B,CR	;ALREADY TOO FAR RIGHT, START WITH CRLF
		DPB B,A
		IBP A
		MOVEI B,LF
		MOVEI LNO,1(LNO)
		ADD C,CNO
		AOJA C,.+2]
	MOVEI B," "
	SUBI C,5		;MOVE LEFT 5 MORE COLUMNS IF POSSIBLE.
		;THIS MAKES 2-DIGIT PAGE NUMBER LINE UP NICELY
		;OVER 72-COL TEXT WHEN WIDTH IS 80
		;(NORMAL CASE TO LPT:)
	MOVEI CHR," "
	DPB B,A		;STORE FIRST CHAR OVER NULL
	IDPB CHR,A
	SOJG C,.-1
	HRROI B,[ASCIZ /Page /]
	SETZ C,
	SOUT

;LIST/TYPE...
;TERMINATE HEADING STRING AND SAVE THINGS

LSTH4:	SETZ CHR,
	IDPB CHR,A
		;DO NOT SAVE END PTR - REUSE SPACE FOR NEXT FILE
	MOVE A,HEAD
	ILDB A,A		;SEE IF HEADING NULL
	JUMPE A,[SETZM HEAD		;IF SO, SAY SO (SUPPRESSES EOLS AFTER)
		JRST LSTH8]		;DON'T ACCOUNT EOLS AFTER
	MOVEI LNO,3(LNO)		;ALLOW FOR EOL'S AFTER HEADING
	ADD LNO,SPCG
LSTH8:	MOVEM LNO,HEDLNO		;NUMBER OF LINES USED BY HEADING AND EOLS
	TLZ F,B11+B12
;REST OF PER-FILE INITIALIZATION
		;EOF PSI DISPATCH
	MOVEI A,LSTEOF
	MOVEM A,EOFDSP
		;INIT CHARACTER POSITION, PAGE #, BUFFERS, ETC
	SETZB LNO, BESLNO
	SETZB CNO,PAGEN1
	MOVEI A,1
	MOVEM A,PAGENO
	MOVE INPTR,[POINT 7,[0],-1]		;NO TEXT IN INBUF
	SETZ CNT,		;..
	MOVEM INPTR,BESPTR		;NO TEXT SAVED FROM LAST PAGE
	MOVE OUTPTR,[POINT 7,BUF1]		;JUST FOR SAFETY
;PASS EOLS AT BEGINNING OF FILE
	TLO F,B4
LSTIGE:	CALL GETC
	CAIE CHR,LF
	CAIN CHR,CR
	JRST LSTIGE
	CAIN CHR,FORMF		;IGNORE BEGINNING ^L FOR PRINTING
	AOSA PAGENO		;BUT BUMP PAGE NUMBER TO REFLECT IT
	CAIN CHR,EOL
	JRST LSTIGE
		;200 FOR EOF REMAINS IN CHR TIL TITLE IS PRINTED

;SCAN TEXT IN FIRST BUFFERFUL AND CHECK FOR UNREASONABLE CONCENTRATION
; OF OF CONTROL CHARACTERS
	TLNN F,B15		;OMIT CHECK IF SOURCE IS TTY
	CAIG CNT,^D200		;OMIT CHECK FOR VERY SHORT FILES
	 JRST LSTGCE
	MOVE A,INPTR		;INITIAL BYTE PTR
	MOVE C,CNT		;COUNT OF CHARS IN BUFFER
	SETZ D,			;INIT CONTROL CHAR COUNT
LSTGCK:	ILDB B,A		;GET CHAR FROM BUFFER
	CAIL B,40		;SKIP IF A CONTROL CHARACTER
	 JRST .+4		;NOT, CONTINUE
	CAIL B,10		;DON'T COUNT ^H THRU ^M
	CAILE B,15
	 JRST [	SKIPE 0(A)	;WHOLE WORD NULL?
		JUMPE B,.+1	;NO, DON'T COUNT NULL CHR
		AOJA D,.+1]	;COUNT IF WORD NULL OR CHR NON-NULL
;;;NB: THIS REALLY SHOULD NOT APPLY IF THIS CONTROL CHARACTER
;;;	WAS PRECEEDED BY A LINE PRINTER GRAPHIC QUOTE.  THIS IS
;;;	177 FOR ANELEX, AND SOME OTHERS.
	SOJG C,LSTGCK		;REPEAT FOR ALL CHARACTER IN BUFFER
	IMULI D,^D100/GBGPCT	;CHECK FOR GT GBGPCT % CONTROL CHARAS
	CAMG D,CNT
	 JRST LSTGCE		;FILE IS OK, CONTINUE
	HRRZ A,@INIFH1		;TOO MANY, COMPLAIN
	ETYPE < [File %1S contains excessive control characters
and does not look like a text file.  Type CR to print it anyway, or
Rubout to bypass it]>
	BTCHER			;THIS IS AN ERROR UNDER BATCH
	CALL TCONF		;REQUIRE CONFIRMATION FROM USER
	 JRST LIST8		;NOT CONFIRMED, BYPASS THIS FILE
LSTGCE:	CALL GETC4		;ACCOUNT FOR CHAR TO BE PRINTED
	JRST LSTTOP		;SKIP SKIPPER

;LIST/TYPE...   SKIP PAGE

LSKIP:	TLO F,B4		;SUPPRESS PRINTING AND ACCOUNTING
		;IGNORE CARRY-OVER TEXT. IT CAN'T CONTAIN A SIGNIFICANT ^L,
		;INDEED I THINK IT CAN'T BE NON-NULL.
		;SCAN TO ^L.
	CALL GETC		;GET CHAR FROM INBUF
	CAIN CHR,200
	JRST LIST8		;EOF, DONE LISTING
	CAIE CHR,FORMF
	JRST .-4
		;SCAN PAST IMMEDIATELY FOLLOWING EOLS & ^L'S -- THEY'RE
		;PART OF SAME PAGE.
	CALL GETC
	CAIE CHR,CR
	CAIN CHR,LF
	JRST .-3
	CAIE CHR,EOL
	CAIN CHR,FORMF
	JRST .-6
	CAIN CHR,200
	JRST LIST8		;EOF, DONE LISTING
	SETZB LNO,BESLNO
	SETZ CNO,
	MOVE A,[POINT 7,[0],-1]
	MOVEM A,BESPTR		;EMPTY TEXT CARRIED OVER FROM PREVIOUS PAGE
	AOS PAGENO
		;FALL INTO LSTTOP, FIRST CHAR OF PAGE IN "CHR"

;LIST/TYPE...   TOP OF PAGE LOOP.  DETERMINE WHETHER PAGE WILL PRINT.
	TRO F,1B19		;SAY THAT SOME OUTPUT HAS BEEN GENERATED


LSTTOP:	HLRZ A,@PPRINT		;MIN OF GROUP OF PAGES TO PRINT
	JUMPE A,LIST8		;END OF PAGES TO PRINT BLOCK, DONE THIS FILE
	CAMLE A,PAGENO
	JRST LSKIP		;SKIP PAGE
	HRRZ A,@PPRINT		;MAX OF SAME GROUP
	CAMGE A,PAGENO
	JRST [	AOS PPRINT		;BEYOND THIS GROUP, GET NEXT
		JRST LSTTOP]
	TLZ F,B4		;WILL PRINT, TURN ON PRINTING.
	TRO F,1B19		;SAY THAT SOME OUTPUT HAS BEEN GENERATED
;PRINT PAGE. FIRST HEADING AND PAGE NUMBER
	TLNE F,B14
	JRST [		;PAUSE BEFORE EACH PAGE REQUESTED
		PRINT BELL		;RING CONTROLLING TTY BELL
		MOVE A,CIJFN
		BIN		;USER SHOULD TYPE EOL
		MOVE A,COJFN
		JRST LSP2A]
	MOVE A,OUTDSG
	MOVEI B,CR
	BOUT
	MOVEI B,LF
	BOUT
LSP2A:	SETZ C,
	MOVE B,HEAD		;HEADING STRING, INCL "PAGE "
	JUMPE B,LSTP2C		;NO HEADING OR PAGE #'S AT ALL
	SOUT
	TLNE F,B3
	JRST LSTP2B		;NO PAGE #
	MOVE B,PAGENO
	MOVEI C,^D10
	NOUT		;PAGE NO
	 CALL JERRC
	SKIPN PAGEN1
	JRST LSTP2B
	MOVEI B,":"
	BOUT
	MOVE B,PAGEN1
	NOUT
	 CALL JERRC
LSTP2B:	MOVEI B,CR
	BOUT
	MOVEI B,LF
	MOVE C,SPCG
	ADDI C,3		;SPACING + 2 EOLS
	BOUT
	SOJG C,.-1
LSTP2C:	ADD LNO,HEDLNO		;ACCOUNT LINES IN TITLE, INCL EOLS
				;BEFORE AND AFTER

;LIST/TYPE...   PRINT TEXT CARRIED FORWARD FROM PREVIOUS PAGE
;(NULL IF PREVIOUS PAGE NOT LISTED OR ^L FOUND, BUT NON-NULL AFTER
;OVERLONG PAGE BROKEN AT BEST POINT)
		;MOVE A,OUTDSG
	MOVE B,CHR
	CAIE CHR,200		;NULL FILE CASE EOF
	BOUT		;THE FIRST CHARACTER OF PAGE IS IN "CHR"
	MOVE B,BESPTR		;POINTER TO UNOUTPUT TEXT IN OUTPUT BUFFER
	SETZ C,
	SOUT
;INIT TO DO PAGE
	SUB LNO,BESLNO		;REDUCE LINE # BY # LINES PRINTED ON LAST PAGE
		;THIS SHOULD LEAVE LNO SET TO NUMBER OF EOLS
		;IN TEXT JUST PRINTED
	MOVE OUTPTR,[POINT 7,BUF2,-1] ;WHERE TO STORE TEXT TO BE OUTPUT
	MOVNI B,B0		;SET SCORE OF BEST PLACE YET SEEN TO BREAK
	MOVEM B,BESCOR		;PAGE TO MINUS INFINITY
	MOVEM OUTPTR,BESPTR		;JUST IN CASE
	MOVEM LNO,BESLNO		;...
	TLZ F,B5+B6		;DON'T KNOW WHETHER LAST LINE WAS COMMENT OR NOT
;CHARACTER LOOP.
;CHARACTERS ARE READ AND BUFFERED.
;EOLS AFTER LINE "35" ARE SCORED AS POSSIBLE PAGE BREAK POINTS;
;PRINTING DOES NOT OCCUR TIL ^L OR "60"TH EOL.

LSTCL:	CALL GETC
LSTCL1:	CAIE CHR,200		;EOF
	CAIN CHR,FORMF		;^L
	JRST LSPFF		;GO PRINT TO HERE
	CAIE CHR,EOL
	CAIN CHR,LF
	JRST .+2		;END OF LINE
	JRST LSTCL		;ANY OTHER CHAR, LOOP.
;HAVE EOL
	CAML LNO,L35
	JRST LSTCL2
	MOVEM OUTPTR,BESPTR ;SAVE AS A BREAK POINT IN CASE NO 
	MOVEM LNO,BESLNO		;...LINES BETWEEN "35" AND "60" DUE TO
	JRST LSTCL		;...SMALL LENGTH AND LARGE SPACING
;HAVE AN EOL BEYOND LINE "35". IF BEYOND "LENGTH", PRINT.

LSTCL2:	CAMLE LNO,LENGTH		;OFF BOTTOM OF PAGE?
	JRST LSPNFF		;YES, PRINT TO HIGHEST-SCORING BREAK SEEN

;LIST/TYPE...   HAVE EOL, SCORE BREAK AT THIS POINT
	PUSH P,OUTPTR
	PUSH P,LNO
		;WIDTH OVERFLOW FORCED EOL: BASIC SCORE IS -200
	TLNE F,B8
	JRST [	HRROI E,-^D200
		CALL GETC
		JRST LSTC3X]
	SETZ E,		;INITIALIZE SCORE
		;SCAN PAST EOLS & BLANKS, SCORING +10 PER EOL,
		;-1 PER COLUMN INDENTATION
LSTC3A:	CALL GETC
	CAIN CHR,CR
	JRST LSTC3A
	CAIE CHR,LF
	CAIN CHR,EOL
	JRST [	ADDI E,^D10
		TLZ F,B5		;IMMEDIATELY PRECEDING LINE NOT COMMENT
		JRST LSTC3A]
	CAIE CHR,200		;EOF
	CAIN CHR,FORMF		;FORM FEED AFTER EOL(S)
	JRST [	POP P,BESLNO		;PRINT TO BEFORE THE EOLS (WHICH MIGHT
		POP P,BESPTR		;HAVE CROSSED PAGE LENGTH)
		JRST LSPFF1]
	JRST .+2
LSTC3B:	CALL GETC		;AFTER SPACE-TAB DON'T CHECK FOR FF: IF BEYOND
		;PAGE LENGTH THEN ITS ON NEXT PAGE.
	CAIN CHR," "
	SOJA E,LSTC3B
	CAIN CHR,TAB
	JRST [	SUBI E,10
		JRST LSTC3B]
		;NOW IF WE ARE AT LEFT MARGIN, ADJUST FOR COMMENTS
	CAILE CNO,1
	JRST LSTC3D
	CAIN CHR,"!"
	JRST LSTC3C
	CAIE CHR,"$"		;FOR FORTRAN
	CAIN CHR,"/"		; "    "
	JRST LSTC3C
	CAIE CHR,";"
	CAIN CHR,"*"
LSTC3C:	JRST [	TLZE F,B6
		ADDI E,^D50		;+50 IF PREVIOUS LINE NO COMMENT
		TLOE F,B5		;-20 IF LAST LINE WAS COMMENT, TO AVOID
		SUBI E,^D20		;BREAKING UP BLOCKS OF COMMENTS
		JRST LSTC3X]
		;-100 FOR ), ] AT LEFT MARGIN, FOR LISP PRETTYPRINT LISTINGS
	CAIE CHR,")"
	CAIN CHR,"]"
	SUBI E,^D100
	CAIN	CHR,">"
	SUBI	E,^D100

;LIST/TYPE... SCORING BREAK AT EOL...
		;IF HERE, THIS LINE WAS NOT COMMENT AT LEFT MARGIN
LSTC3D:	TLZ F,B5
	TLO F,B6
		;NOW REDUCE ALL SCORES BY # LINES AWAY FROM "50"
LSTC3X:	MOVE A,L50
	SUB A,(P)		;LNO SAVED BEFORE SCANNING PAST EOLS
	MOVM A,A
	SUB E,A
		;UPDATE BEST BREAK SEEN IF THIS ONE IS BETTER
	CAML E,BESCOR
	JRST [	POP P,BESLNO		;THIS ONE IS BETTER
		POP P,BESPTR
		MOVEM E,BESCOR
		JRST .+2]
	SUB P,[2,,2]
	JRST LSTCL1

;PRINT PAGE

;NO FORM FEED, PRINT TO BEST BREAK SEEN

LSPNFF:	AOS PAGEN1
	JRST LSTP1

;FORM FEED OR EOF, PRINT TO HERE

LSPFF:	CAML LNO,LENGTH		;IF BEYOND BOTTOM OF PAGE,PRINT INSTEAD
	JRST LSPNFF		;TO BEST PRECEDING BREAK
	MOVEM OUTPTR,BESPTR	;MAKE THIS POINT THE BEST BREAK SEEN
	MOVEM LNO,BESLNO		;..
LSPFF1:	SETZM PAGEN1		;FF AFTER EOL JOINS HERE (LSTC3A)
;	AOS PAGENO		;THIS IS DONE AT LSTP2+7

;PRINT OUTBUF TO BESPTR EXCEPT THE FINAL EOL OR FF

LSTP1:	MOVE A,BESPTR
	BKJFN			;BACK UP ONE CHARACTER
	 CALL JERR
	MOVEM A,BESPTR
	MOVE D,BESPTR
	ILDB E,D		;GET CHAR AFTER BEST BREAK
	CAIE E,LF
	CAIN E,EOL
	SOS BESLNO		;UNACCOUNT FOR BACKUP
	CAIE E,LF		;ON LF BACK UP OVER PRECEDING CR
	 JRST LSTP15		;NOT A LF
	LDB A,A			;GET CHR JUST BEFORE LINEFEED
	CAIN A,CR
	JRST LSTP1		;GO BACK UP AGAIN
LSTP15:	LDB A,[POINT 6,D,5]	;NUMBER OF BITS LEFT IN LAST WORD
	IDIVI A,7		;NUMBER OF CHRS
	MOVEI C,BUF2-1		;BEG OF OUTPUT BUF MINUS 5 CHRS
	SUBI C,0(D)		;NUMBER OF FULL AND PARTIAL WORDS
	IMULI C,5		;NUMBER OF CHRS THEREIN
	ADDI C,1(A)		;NEG CHR CNT (NOT INC. CHR AT "BESPTR")
	JUMPGE C,LSTP19		;NO CHAR'S TO BE OUTPUT
	MOVE A,OUTDSG
	HRROI B,BUF2
	SOUT			;PRINT 

;LIST/TYPE...   PRINT PAGE...
;AFTER PRINTING PASS EOLS AND ^L'S, PRINTING THOSE THAT WILL FIT PAGE,
;THEN SEND A REAL FORM FEED.
LSTP19:	TLZ F,B10		;PERMIT PRINTING
LSTP2:	MOVE A,OUTPTR
	SETZ C,
	IDPB C,A		;TERMINATE OUTBUF
	CALL GGETC		;GET CHR FROM OUTPUF IF NOT ALL USED UP,
				;ELSE FROM INBUF
	MOVE A,OUTDSG
	SETZ C,
	CAIN CHR,FORMF
	JRST [	HRROI B,[ASCIZ /^L/]
		TLNN F,B10
		SOUT
		AOS PAGENO
		JRST LSTP2]
	CAIN CHR,CR
	JRST [	MOVE D,BESLNO
		AOJA D,[CAML D,LENGTH	;IS PAGE TOO FULL FOR LF AFTER?
			TLO F,B10	;YES, SUPPRESS PRINTING
			MOVE B,CHR
			TLNN F,B10
			BOUT
			JRST LSTP2]]
	CAIE CHR,EOL
	CAIN CHR,LF
	JRST [	AOS D,BESLNO
		JRST [	CAML D,LENGTH	;PAGE FULL?
			TLO F,B10	;YES, SAY NO PRINT
			MOVE B,CHR
			TLNN F,B10
			BOUT
			JRST LSTP2]]
	IDPB C,OUTPTR		;TERMINATE CARRY-OVER TEXT
	MOVEI B,FORMF
	BOUT			;REAL FORM FEED
	CAIE CHR,200		;EOF ?
	JRST LSTTOP		;NO, GO DO NEXT PAGE, ITS 1ST CHAR IN "CHR"

;LIST/TYPE...
;END-OF-FILE HAS BEEN PROCESSED

LIST8:	CALL GNFIL		;GET NEXT FILE IN INPUT GROUP
	JRST LIST9		;R1: NO MORE
	JRST LSTFL		;R2: HAVE IT, GO BACK AND LIST IT.

;ALL DONE LISTING FILES

LIST9:
	TRNN F,1B19		;IF NO OUTPUT WAS ACTUALLY GENERATED,
	JRST [	MOVE A,OUTDSG	;ATTEMPT TO DELETE THE (EMPTY) FILE
		DELF
		 JFCL
		JRST LIST91]	;BYPASS EXTRA EOL AND PRINTER WATCH ON
		;SEND ONE LAST EOL (NOT DONE EXCEPT AFTER LAST FILE
		;BECAUSE IN OTHER CASES NEXT PAGE BEGINS WITH EOL OR PAUSE)
	MOVE A,OUTDSG
	MOVEI B,CR
	BOUT
	MOVEI B,LF
	BOUT

	TLNE F,(1B0)		;"WATCH"
	SETZM PRNTIM		;YES, ENABLE CHECKING
				;UNMAP STORAGE PAGES
LIST91:	CALL UNMDIR		;SUBROUTINE IN X3CMD.MAC THAT UNMAPS PAGES
		;BUF1 TO 767.
		;RELEASE JFNS
	CALL RLJFNS
		;IF REQUESTED BY SUBCOMMAND, GO LOGOUT
	TLNN F,B17
	JRST CMDIN4		;GO BACK TO COMMAND INPUT (NORMAL CASE)
	SETO A,			;LOGOUT
	LGOUT
	 CALL JERR

;LIST/TYPE SUBROUTINES

;GGETC
;GET CHAR FROM OUTBUF CARRY-OVER (BESPTR) IF ANY, ELSE FROM INPUT FILE.
;CLOBBERS A-D

GGETC:	MOVE A,BESPTR
	ILDB CHR,A
	JUMPN CHR,[MOVEM A,BESPTR
		RET]
		;OUTBUF EMPTY, GET CHAR(S) INTO IT THEN REENTER GGETC
		;TO GET THEM OUT.  THIS METHOD SIMPLIFIES CORRECT
		;MULTIPLE-SPACING AFTER EOLS IN ALL FUNNY CASES AT END OF PAGE.
	CALL GETC
	CAIE CHR,200
	JRST GGETC
	RET		;200 FOR EOF ISN'T PUT IN OUTBUF

;GETC
;GET CHARACTER FROM INPUT FILE,
;PUTTING IT IN OUTBUF, KEEPING TRACK OF CHARACTER POSITION ON PAGE,
;INSERTING EOLS FOR LINE WIDTH OVERFLOW AND MULTIPLE SPACING, ETC.
;CLOBBERS A-D.

GETC:	TLNE F,B7+B8+B12+B13
	JRST GETC20		;GO HANDLE SPECIAL CONDITIONS
;GET CHARACTER FROM INPUT BUFFER
	ILDB CHR,INPTR
	SUBI CNT,1		;UPDATE COUNT OF CHARS REMAINING
	JUMPE CHR,[;NULL ENCOUNTERED.  THIS IS END OF BUFFER ONLY IF
		;COUNT ALSO USED UP, SO NULLS IN A BAD FILE DON'T
		;CAUSE LOSS OF FOLLOWING GOOD DATA IN SAME BUFFER.
		;COUNT IS DISREGARDED TIL A NULL TO PERMIT USE IN
		;SCANNING DEFAULT HEADING, AN ASCIZ STRING OF UNKNOWN
		;LENGTH.
		JUMPG CNT,.+1		;NOT END OF BUFFER, TRANSMIT NULL.
		TLNE F,B11		;DID READING THIS BUFFER HIT EOF?
		JRST [	TLO F,B12		;YES, SAY ALL CHARS NOW USED
			JRST GETC]		;REENTER GETC TO RET SPEC CODE.
		MOVE INPTR,[POINT 7,INBUF,-1]
		HRRZ A,@INIFH1
		MOVE B,INPTR
		MOVEI CNT,INBUFL
		MOVE C,CNT
		TLNN F,B15		;IF NOT TTY:, THEN..
		MOVNI C,INBUFL		;USE NEG. SIN COUNT FOR SPEED
		MOVEI D,CTRLZ		;END ON ^Z FOR TTY
		SIN		;READ A BUFFERFUL
		JRST LSTE1]	;GO COMPUTE COUNT

;LIST/TYPE SUBR GETC...
;FOR TTY SOURCE ^Z IS EOF
	CAIN CHR,CTRLZ
	JRST [	TLNN F,B15
		JRST .+1
		SETZM EOFDSP
		TLO F,B12
		JRST GETC]
;IF NOT PRINTING, DON'T STORE OR ACCOUNT CHAR POSITION
	TLNE F,B4
	RET
;ACCOUNT CHARACTER POSITION AND SO ON

GETC4:	CAIG CHR,37
	JRST GETC10		;CONTROL CHAR
		;ALL OTHER CHARS SPACE ONE
GETC4A:	MOVEI CNO,1(CNO)
GETC7:	CAMLE CNO,WIDTH
	JRST [		;PAGE WIDTH OVERFLOW
		MOVE A,INPTR
		BKJFN		;PUT CHAR BACK IN BUFFER
		 CALL JERR
		MOVE INPTR,A
		MOVEI CHR,EOL		;RETURN EOL
		TLO F,B8		;SAY IT WAS FORCED EOL
		TLZ F,B9		;SAY NOT CONTROL CHAR TO INDICATE W ^X
		JRST GETC4]
;STORE CHAR IN OUTBUF AND RETURN

GETC8:	TLZE F,B9
	JRST [		;INDICATE CONTROL CHARACTER WITH ^X
		MOVEI B,"^"
		IDPB B,OUTPTR
		MOVEI B,100(CHR)
		IDPB B,OUTPTR
		RET]
	IDPB CHR,OUTPTR		;STORE CHAR FOR PRINTOUT
	RET

;LIST/TYPE SUBROUTINE GETC...
;CONTROL CHARACTERS

GETC10:	TLNN F,B2		;INDICATING NULLS,...
	JUMPE CHR,GETC		;OR NOT A NULL
	CAIN CHR,TAB
	JRST [	ADDI CNO,10	;ASSUME TAB STOPS EVERY 8 COLUMNS
		TRZ CNO,7
		JRST GETC7]
	CAIN CHR,EOL
	 JRST [	SETZ CNO,
		TLO F,B13	;SAY TO OUPUT AN LF NEXT CALL
		MOVEI CHR,CR	;BUT DO A RETURN THIS TIME
		JRST GETC8]
	CAIN CHR,LF
GETC11:	JRST [	MOVEI LNO,1(LNO)
		SKIPE SPCG	;IF SPACING >1,
		TLO F,B7	;SAY DO MULTIPLE-SPACING ON NEXT CALL
		JRST GETC8]
	CAIN CHR,CR
	JRST [	SETZ CNO,
		JRST GETC8]
	CAIN CHR,FORMF
	JRST GETC8		;FORMFEED ISN'T ACCOUNTED AT GETC LEVEL

;REMAINING CONTROLS ARE EITHER INDICATED (^X, 2 COLS) OR SENT (1 COL)

	TRNE F,1B18		;"VERBATIM"
	JRST [	MOVE A,SPCBTS	;YES, IS THIS A SPACING CHAR?
		LSH A,(CHR)
		JUMPGE A,GETC7	;NO, JUST PRINT WITHOUT ACCOUNTING
		CAIN CHR,10	;BACKSPACE?
		SOJGE CNO,GETC7
		AOJA CNO,GETC7]
	TLO F,B9		;REMEMBER THIS SPECIAL CASE
	MOVEI CNO,2(CNO)	;^X TAKES 2 COLUMNS
	JRST GETC7

;LIST/TYPE SUBROUTINE GETC...
;SPECIAL FLAG(S) ON AT (RE)ENTRY

GETC20:	TLNE F,B12
	JRST [	MOVEI CHR,200		;AT EOF, RETURN SPECIAL CODE 200
		JRST GETC8]		;PUT NULL IN OUTBUF
	TLZE F,B13		;LAST CALL OUTPUT CR IN PLACE OF EOL
	 JRST [	MOVEI CHR,LF	;STUFF OUT LF THIS TIME
		JRST GETC11]
	TLNE F,B4
	JRST [	TLZ F,B7+B8		;NOT PRINTING, DONT PROCESS THESE
		JRST GETC]		;SPECIAL CASES
	TLZE F,B8
	JRST [		;ON CALL AFTER LINE WIDTH OVERFLOW FORCED EOL, STORE **
		;NOTE THAT FORCED EOLS ALWAYS SINGLE-SPACE
		TLZ F,B7
		MOVE C,WIDTH	;SPACE HALFWAY ACROSS LINE TO CONTINUE
		ASH C,-1
		ADD CNO,C
		MOVEI B," "
		JSP D,[JRST 0(D)] ;REMEMBER 'POINT'
		IDPB B,OUTPTR
		SOJG C,0(D)	; .-1 ACTUALLY...
		MOVEI B,"*"
		IDPB B,OUTPTR
		IDPB B,OUTPTR
		MOVEI CNO,2(CNO)
		CAML CNO,WIDTH		;FOR SAFETY: OTHERWISE IF WIDTH IS 0
		CALL SCREWUP		;EXEC IS WIPED OUT BY HEADING
		JRST GETC]		;REENTER GETC TO GET CHARACTER
	TLZN F,B7
	CALL SCREWUP


;ON CALL AFTER EOL OR LF, STORE EXTRA CRLF + LF'S FOR MULT SPACING
	MOVE D,SPCG
	ADD LNO,D
	MOVEI B,CR
	IDPB B,OUTPTR
	MOVEI B,LF
	IDPB B,OUTPTR
	SOJG D,.-1
	JRST GETC		;REENTER GETC TO GET CHARACTER

;LIST/TYPE EOF PSI ROUTINE. CAN ONLY BE ENTERED DURING CALL TO GETC.

LSTEOF:	SETZM EOFDSP		;JUST TO BE SURE
	TLO F,B11		;SAY EOF ENCOUNTERED
LSTE1:	MOVMS C
	SUB CNT,C		;COMPUTE NUMBER CHARS READ
	SETZ C,
	IDPB C,B		;TERMINATE WITH NULL!
	JRST GETC		;GET CHAR FROM BUFFERFUL JUST READ, AND
				;CONTINUE NORMALLY TILL BUFFER USED.

;LIST/TYPE ...

;OUTPUT THE COMMENT CHARACTER INTO THE HEADING STRING
;CHARCRER (STRING) IS DETERMAMINED FROM FILE EXTENSION

;1:	OUTPUT STRING POINTER
;	CALL COMCHR
;R+1:	ALWAYS, 1 UPDATED

COMCHR:	PUSH P,1
	PUSH P,2
	PUSH P,3
	SETOM (1)		;IN CASE NO EXTENSION
	HRRZ 2,@INIFH1		;CURRENT JFN
	MOVSI 3,(1B11)		;EXT ONLY
	JFNS

COMCH1:	MOVSI 3,-EXTL
COMCH2:	MOVSI 2,(POINT 7,)
	HLR 2,EXTTAB(3)
	MOVE 1,-2(P)		;WHERE EXT WRITTEN
	CALL STRCOM		;COMPARE STRINGS
	 JRST [	AOBJN 3,COMCH2	;NOT EQUAL, TRY NEXT
		MOVEI 2,";"	;USE  ;  IF NOTHING ELSE
		MOVE 1,-2(P)
		BOUT
		JRST COMCHX]
	HRRO 2,EXTTAB(3)
	SETZ 3,
	MOVE 1,-2(P)
	SOUT
COMCHX:	POP P,3
	POP P,2
	SUB P,[1,,1]
	RET


;STRING COMPARE

;1:	STRING POINTER
;2:	STRING POINTER
;	CALL STRCOM
;R+1:	 NOT EQUAL
;R+2:	EQUAL

STRCOM:	PUSH P,1
	PUSH P,2
STRCO1:	ILDB 1,-1(P)
	ILDB 2,0(P)
	CAIE 1,0(2)
	 JRST STRCO2
	JUMPN 1,STRCO1
	AOS -2(P)
STRCO2:	POP P,2
	POP P,1
	RET


DEFINE ETAB(TRANS,COMMNT)<[ASCIZ \TRANS\],,[ASCIZ \COMMNT\]>

EXTTAB:	ETAB (MAC,<;>)
	ETAB (MID,</>)
	ETAB (FAI,<;>)
	ETAB (PAL,</>)
	ETAB (BCP,<//>)
	ETAB (B11,<//>)
	ETAB (F4,<C>)
	ETAB (F40,<C>)
	ETAB (FOR,<C>)
	ETAB (F10,<C>)
	ETAB (P11,<;>)
	ETAB (BLI,<!>)
	ETAB (PPL,<... >)
	ETAB (HEADBCP,<//>)
	ETAB (LO,<.*  >)
EXTL==.-EXTTAB

;LIST/TYPE ...

;SUBROUTINE TO OUTPUT SITE ON DESIGNATOR IN A

;RETURNS A UPDATED IF STRING POINTER

SITEO:	PUSH P,B
	PUSH P,C
	PUSH P,A
	MOVE A,['LHOSTN']
	CALL $SYSGT
	JUMPE B,SITEX
	MOVEI A,0(B)		;FORM 0,,TABLE
	GETAB
	 JRST SITEX
	EXCH A,0(P)		;GET BACK OUTPUT PTR, SAVE SITE #
	MOVEI B,"["
	BOUT
	POP P,B			;SITE #
	MOVEI C,^D10		;FOR NOUT
	CVHST			;HOST TO STRING CONVERSION
	 NOUT			;FAILING THAT, A NUMBER
	  JFCL
	MOVEI B,"]"
	BOUT
	CAIA
SITEX:	POP P,A
	POP P,C
	POP P,B
	RET


;LPTCHK CHECKS DESTINATION OF OUTPUT FILE
;AC 1 HAS JFN OF FILE
; RETURN +1 IF LPT OR <PRINTER>
; RETURN +2 OTHERWISE

LPTCHK:	PUSH P,A
	PUSH P,B
	PUSH P,C
	DVCHR
	LDB A,[POINT 9,B,17]	;DEVICE TYPE
	JUMPN A,[CAIN A,7	;PHYSICAL LPT?
		SOS -3(P)	;YES, NO SKIP
		JRST LPTOK1]	;EITHER WAY, RETURN
	SETZ A,			;DSK, CHECK DIR
	HRROI B,[ASCIZ/PRINTER/]
	STDIR
	 JFCL
	 JRST LPTOK1		;NO SUCH DIRECTORY
	PUSH P,A		;SAVE DIRECTORY #
	HRROI A,1(P)		;PUT DIR NAME INTO STACK
	MOVE B,-3(P)		;JFN
	MOVSI C,(1B5)		;OUTPUT DIR, NO PUNC
	JFNS
	SETZ A,			;NO RECOGNITION
	HRROI B,1(P)
	STDIR
	 JFCL
	 JRST LPTOK2		;NO DIRNAME FOR THIS FILE
	CAMN A,0(P)		;PRINTER DIR?
	SOS -4(P)		;YES
LPTOK2:	POP P,A			;POP DIR #
LPTOK1:	POP P,C			;POP JFN
	POP P,B
	POP P,A
	AOS 0(P)
	RET

LITC4A:	LIT

;"REDIRECT" AND "DETACH" COMMANDS

;REDIRECT (INFILE) <NAME>/* (OUTFILE) <NAME>/* (AND) START/REENTER/CONT

;DETACH IS SAME SYNTAX AND HAS SAME MEANING EXCEPT IT DETACHES
; TERMINAL AFTER REDIRECTING IO.
;ALL ARGUMENTS CAN BE OMITTED AND DEFAULT TO NULL

.DETAC:	TLO Z,DTACHF		;SET "DETACH" FLAG
.REDIR:				;"REDIRECT": FLAG IS ALREADY CLEAR.

;DECODE ARGUMENTS

;GET INPUT FILE NAME, OR "*" FOR OLD, OR NULL OR "-" FOR NO CHANGE
	NOISE <infile>
	MOVE A,[1,,[ASCIZ /INP/]]	;"ALLOW *" FLAG, DEFAULT EXT
	CALL CINFN		;INPUT A FILE NAME, *, -, OR NULL
	 JRST [	PUSH P,A	;NOT A FILE NAME (* OR -)
		MOVE A,[1,,1];STEP JFN BUFFER PTR PAST CJFN1,
		ADDM A,JBUFP	;SO COUTFN WON'T CLOBBER IT.
		POP P,A
		CAIE A,"*"	;HOW CINFN INDICATES "*"
		JRST [	SETOM CJFN1	;SAY NO INPUT REDIRECTION FILE
			JRST RED2]	;NULL OR "-"
		SKIPG CREDIF	;*. IS THERE A PREVIOUS FILE?
		UERR [ASCIZ /No previous input file/]
		MOVE A,CRJFNI	;OLD INPUT JFN FROM BEFORE ^C
		GTSTS		;GET JFN'S CURRENT STATUS
		TLNN B,200	;JFN STILL VALID? (USER CD HAVE FLUSHED)
		JRST [	SETZM CREDIF		;INVALID, FORGET IT
			UERR [ASCIZ /Old input file has been closed & released/]]
		TLNE B,B0	;OPEN?
		TLNN B,B1	;FOR INPUT?
		JRST [		;JFN IS ASSOCIATED WITH A FILE, BUT FILE
				;ISN'T OPEN FOR INPUT.
				;IDEALLY WE SHOULD HAVE SAVED THE OLD
				;FILE POINTER TO RESTORE AND CONTINUE.
				;(AND ALSO I GUESS THE FILE'S NAME TO BE
				;SURE USER HASN'T OPENED ANOTHER FILE
				;WITH SAME JFN.)  FOR NOW, ERROR.
			UERR [ASCIZ /Old input file has been closed/]]
			JRST .+1]	;ITS OK.
	MOVEM A,CJFN1		;JFN FROM CINFN OR CRJFNI
	SKIPGE CREDIF
	ERROR <Input already redirected>
RED2:	ALLOW TALT+TSPC+TEOL+TLPR

;DECODING OF REDIRECT/DETACH...

;OUTFILE SIMILALARLY

	NOISE <outfile>
	MOVE A,[1,,[ASCIZ /OUT/]]
	CALL COUTFN
	 JRST [	CAIE A,"*"
		JRST [	SETOM CJFN2
			JRST RED4]
		SKIPG CREDOF
		UERR [ASCIZ /No previous output file/]
		MOVE A,CRJFNO
		GTSTS			;CHECK ITS VALIDITY
		TLNN B,200
		JRST [	SETZM CREDOF	;BAD JFN, FORGET ABOUT IT
			UERR [ASCIZ /Old output file has been closed & released/]]
		TLNE B,B0		;OPEN?
		TLNN B,B2		;FOR WRITE?
		 JRST [	UERR [ASCIZ /Old output file has been closed/]]
		JRST RED3]
	TLO KWV1,CONMAN		;IF FILE NAME WAS GIVEN, CONF. MANDATORY
	TRNE CBT,TSPC		;IF FILE NAME WAS TERMINATED WITH SPACE,
	PRINT " "		;TYPE SPACE AFTER "[OLD/NEW FILE]"
RED3:	MOVEM A,CJFN2
RED4:	ALLOW TALT+TSPC+TEOL+TLPR

;START/REENTER/CONTINUE ARGUMENT

	NOISE <and>
	KEYWD $REDIR
	 T -,,EOLOK,<[..DTCH,,[RET]]>		;DEFAULT TO NOTHING
	ERROR <"START", "REENTER", "CONTINUE", or nothing>

;KWV POINTS TO A WD WHOSE RH POINTS TO A SUBR TO FINISH DECODING
;  AND CHECK THE ARGUMENT.
	MOVE A,(KWV)
	CALL (A)	;CALL ARGUMENT-DEPENDENT DECODE & CHECK SUBR
	CONFIRM

;REDIRECT/DETACH...
;EXECUTE REDIRECT/DETACH COMMANDS
;NOW HAVE JFN'S IN CJFN1 & 2, PTR TO START/REE/CON/NOTHING IN KWV.

;EXECUTION BEGINS WITH REDIRECTING THE I/O.
;IT APPEARS THAT WE MUST FLUSH OLD SAVED PRIMARY FILES BEFORE
; REDIRECTING TO THE NEW ONES IN ORDER TO AVOID A HORRENDOUSLY
; COMPLICATED PROBLEM OF KEEPING TRACK OF EVERYTHING AND MAKING
; THE RIGHT THING HAPPEN ON ERRORS AND ^C'S WHICH OCCUR
; DURING THE REDIRECTION PROCESS.
;THIS MEANS THAT IF COMMAND DOESN'T COMPLETE SUCCESSFULLY THE
; OLD FILES MAY NEVERTHELESS BE CLOSED.

	TLNE Z,DTACHF
	ETYPE < Detaching job # %J
>

;Because we have removed the check for output already redirected
; we now have to get rid of the old output file if it is to be
; changed.

	SKIPGE CREDOF		;IS OUTPUT REDIRECTED
	SKIPG CJFN2		;NEXT OUTPUT FILE
	JRST REDI0		;NO CHANGE OR NOT REDIRECTED
	NOINT
	MOVEI A,.FHSLF
	GPJFN
	HRR B,PRIMRY
	SPJFN			;SET OUTPUT TO SAME AS STARTUP
	MOVMS CREDOF		;SAY NOT NOW REDIRECTED
	OKINT
	;...

;EXECUTION OF REDIRECT/DETACH...
;REDIRECT INPUT
; CLOSE OLD FILE
	;...
REDI0:	MOVE A,CRJFNI
	MOVE B,CREDIF
	CAIN B,1		;IS THERE AN OLD ONE?
	CAMN A,CJFN1		;YES, IS IT DIFFERENT FROM NEW?
	 JRST REDI2		;NO OR NO: NO OLD ONE, OR "*" GIVEN.
	GTSTS			;GET CURRENT STATUS OF THIS OLD JFN
	TLNN B,200
	 JRST REDI1		;NO GOOD, FORGET IT.
	TLNN B,B0
	 JRST [	RLJFN		;GOOD BUT NOT OPEN, JUST RELEASE IT
		 CALL JERR
		JRST REDI1]
	CLOSF			;CLOSE OLD ONE & RELEASE JFN
	 CALL JERR
REDI1:	SETZM CREDIF		;SAY THERE'S NO LONGER AN OLD ONE


; OPEN NEW INPUT FILE IF NOT OPEN
; (NOTE THAT IF * GIVEN IT WILL TYPICALLY BE OPEN)

REDI2:	MOVE A,CJFN1		;JFN OF NEW PRI INPUT FILE
	JUMPL A,REDI4		;-1 MEANS NONE SPECIFIED
	GTSTS			;GET ITS STATUS
	TLNN B,200
	 CALL SCREWUP		;BUG IF BAD JFN GETS THIS FAR.
	TLNE B,B1
	 JRST REDI3		;ALREADY OPEN FOR READ
	MOVE B,[7B5+0B9+1B19]	;7 BIT ASCII READ
	OPENF
	 CALL JERR

REDI3:	NOINT			;BE SURE CREDIF AND SPJFN AGREE
	MOVEI 1,.FHSLF
	GPJFN
	HRL 2,CJFN1		;NEW INPUT JFN
	SPJFN
	SETOM CREDIF		;INDICATE INPUT NOW REDIRECTED
	OKINT
REDI4:

;REDIRECT/DETACH...
;EXECUTION...
;REDIRECT OUTPUT
; CLOSE OLD FILE IF THERE IS ONE AND IT'S NOT TO BE REUSED
REDO0:	MOVE A,CRJFNO
	MOVE B,CREDOF
	CAIN B,1
	CAMN A,CJFN2
	 JRST REDO2
	GTSTS		;MAKE SURE ITS GOOD AND OPEN BEFORE CLOSING
	TLNN B,200
	 JRST REDO1		;BAD, FORGET IT
	TLNN B,B0
	 JRST [	RLJFN		;GOOD BUT CLOSED, JUST RELEASE
		 CALL JERR
		JRST REDO1]
	CLOSF		;GOOD AND OPEN, CLOSE AND RELEASE.
NOIAC <	 CALL JERR>
IAC <	 JFCL		; MAY NOT BE CLOSABLE (?) >
REDO1:	SETZM CREDOF

; OPEN NEW FILE, IF ANY

REDO2:	MOVE A,CJFN2
	JUMPL A,REDO4		;NO NEW FILE
	GTSTS
	TLNN B,200
	 CALL SCREWUP		;BAD JFN SHOULDN'T GET THIS FAR
	TLNE B,B2		;OPEN FOR OUTPUT?
	 JRST REDO3		;ALREADY OPEN FOR WRITING.
	MOVE B,[7B5+0B9+1B20]	;7 BIT ASCII WRITE
	OPENF
	 CALL JERR

REDO3:	NOINT
	MOVEI 1,.FHSLF
	GPJFN
	HRR 2,CJFN2		;NEW OUTPUT JFN
	SPJFN
	SETOM CREDOF
	OKINT
REDO4:	MOVEI A,.FHSLF		;TTY MODES FOR USE WHEN EXEC IS RUNNING
	CALL SFKTTM##		;PUT SAME INTO EFFECT NOW.

;REDIRECT/DETACH...
;EXECUTION...

;I/O ALL REDIRECTED, NOW START/REENTER/CONTINUE.
;KWV POINTS TO WD WHOSE LH POINTS TO ROUTINE TO START THE FORK (OR NOT),
; DETACH TERMINAL IF "DTACHF" ON, WAIT FOR TERMINATION.
	HLRZ A,(KWV)
NOIAC <	JRST (A)		;DISPATCH TO
		;FINAL-ARGUMENT-DEPENDENT EXECUTION ROUTINE
>
IAC <	CAIN	A,..DTCH	; START/REENTER/CONTINUE GIVEN?
	JRST	(A)		; NO
	SKIPG	FORK		; YES; GOT A FORK?
	JRST	(A)		; NO, DON'T WORRY ABOUT PRIMARIES
	NOINT			; YES; DON'T ALLOW INTERRUPTS
	PUSH	P,A
	MOVEI	A,.FHSLF
	GPJFN
	MOVE	A,FORK
	SPJFN			; SET LOWER FORK'S PRIMARY JFNS!!
	POP	P,A		; RESTORE DISPATCH
	OKINT			; ALLOW INTERRUPTS
	JRST	(A)		; AND GO
>

;TABLE FOR THIRD ARGUMENT
;VALUE POINTS TO A WORD -- 
;	RH: DECODE-AND-CHECK SUBR ADDRESS
;	LH: EXECUTION DISPATCH ADDRESS

$REDIR:	TABLE
	T CONTINUE,,EOLOK,<[..CONT,,$CONTI]>
	T REENTER,,EOLOK,<[..REEN,,$REENT]>
	T START,,EOLOK,<[..STRT,,$START]>
	TEND

;EXECUTION ROUTINE FOR NULL THIRD ARGUMENT

..DTCH:	TLNE Z,DTACHF
	DTACH
	JRST CMDIN4

;..CONT, ..REEN, ..STRT ARE WITH THE CORRESPONDING COMMANDS.

