SUBTTL	B. SCHREIBER - UI HIGH ENERGY PHYSICS GROUP

SEARCH	JOBDAT,UUOSYM,MACTEN,SCNMAC
.DIREC	.XTABM
SALL

;DUMPR VERSION INFORMATION

DMPVER==5	;VERSION
DMPEDT==26	;EDIT
DMPMIN==0	;MINOR VERSION
DMPWHO==0	;WHO

DEFINE	CTITLE (TEXT,MAJVER,VEREDT)
<TITLE	'TEXT'MAJVER(VEREDT)>

CTITLE	(<DUMPR - UTILITY FILE DUMPER %>,\DMPVER,\DMPEDT)

LOC	.JBVER
%%DUMP==:VRSN. (DMP)	;FOR LINK-EDIT MAP
EXP	%%DUMP

;SHOW UNIVERSAL VERSION

%%JOBD==:%%JOBD	;JOBDAT
%%UUOS==:%%UUOS	;UUOSYM
%%MACT==:%%MACT	;MACTEN
%%SCNM==:%%SCNM	;SCNMAC

;REQUEST REST OF LOADING NOW

IF2,<	;ONLY NEED TO REQUEST LOADING IN PASS 2
IFE FT$SEG,<	;IF LOADING RUNNING PART IN LOWSEG
.REQUE	REL:HELPER
IFN FT$WLD,<.REQUE REL:WLD7A>
.TEXT	\REL:ALCOR/SEG:LOW/SEARCH\
.TEXT	\REL:SCN7B/SEG:LOW/SEARCH/EXCLUD:(.SCAN),REL:SCN7B/SEARCH\
>;END IFE FT$SEG

IFN FT$SEG,<	;IF LOADING IT ALL IN HIGH SEGMENT
.REQUE	REL:ALCOR
.REQUE	REL:SCN7B
IFN FT$WLD,<.REQUE REL:WLD7A>
.REQUE	REL:HELPER
>;END IFN FT$SEG
>;END IF2
SUBTTL	REVISION HISTORY

COMMENT	\

1(1)	11/1/76		BIRTH
1(2)	11/2/76		RECOVER FROM BLOCK TOO LARGE WITH /FORTRA OR 
			/IREAD(ON DSK).
1(3)	11/4/76		MAKE DISK IREAD MUCH FASTER.  WORD COUNTS FOR
			NOT /LINRDX:DEC WILL START AT ZERO, RATHER
			THAN ONE.
2(4)	11/4/76		IMPLEMENT /MODE:BYTE:N DUMP.  ADD CODE FOR
			SKIPPING FORTRAN BINARY ON MAGTAPE.
2(5)	11/5/76		IMPLEMENT /MTBUF AND /ERROR
2(6)	11/7/76		MAKE /MODE:ASCII WORK IF NOT /OMIT.
2(7)	11/10/76	MAKE CONTROL CHARACTERS VISIBLE IF/MODE:ASCII/OMIT.
			CORRECT BYTE WIDTH COMPUTATION IF /RADIX ALSO.
2(10)	11/11/76	MAKE /DUMP:F:R WORK IF /SUM. CHANGE JRST DUMP$G
			TO JRST DUMP.2 AT DUMP$G+7.
2(11)	11/14/76	MISC. CLEANUPS. IMPLEMENT "I" OPTION FOR IFTYP.
2(12)	11/15/76	SKIPE T3 IS REALLY SKIPE T2 AT GMBWID+6. THIS
			FIXES PROBLEM WITH /MODE:BYTE DUMPS
2(13)	12/10/76	READ TTY WIDTH IF TTY DUMP AND NO /WIDTH GIVEN.
			FEATURE TEST IREAD STUFF WITH FT$PHX. MISC. CODE
			CLEANUPS.
3(14)	12/27/76	ADD WILDCARDING UNDER FT$WLD CONDITIONAL
3(15)	1/2/77		FINISH WILDCARDING (SINGLE INPUT SPEC ONLY). IF SPOOLED
			OUTPUT AND WILDCARDS, THEN CLOSE AND REOPEN OUTPUT AFTER
			EACH FILE.  FIX UP EIGHT-BIT ASCII PRINTOUT TO MAKE
			ALL CHARACTERS VISIBLE.
3(16)	1/2/77		FIX BUG AT DUMPEF (NO HISEG PRESENT IF FT$WLD=1)
3(17)	1/3/77		MAKE EBCDIC DUMP WORK. ADD /BLOCK TO SPECIFY
			# CHARACTERS IN AN EBCDIC RECORD
4(20)	1/5/77		ADD /POSITION SWITCH.
4(21)	1/6/77		MISC. CLEANUPS
4(22)	1/27/77		ADD [DMPIPT INITIAL POSITION OF TAPE IS FILE N REC M]
			TO SHOW WHERE THE TAPE IS INITIALLY
4(23)	1/27/77		SHOW FILE/RECORD POSITION ON INPUT ERRORS. DO A
			WAIT WHEN ERROR HAPPENS TO MAKE SURE I/O IS OVER
4(24)	2/3/77		MTWAT BEFORE THE TAPOP. IN DMPINI WILL PROBABLY
			CURE SOME OF THE PROBLEMS WITH FUNNY FILE AND
			RECORD COUNTS.
4(25)	2/13/77		SEE IF DEVICE IS ALSO TTY IF MTA (IE NULL) AND
			ZAP DV.MTA IF SO
5(26)	2/18/77		IMPLEMENT /MODE:HALF AND /MODE:SYMBOL

	\;END OF HISTORY
SUBTTL	ASSEMBLY / ACCUMULATOR DEFINITIONS

;ASSEMBLY DEFINES

ND LN$PDL,^D200		;PDL SIZE
ND MY$NAM,'DUMPR '	;MY NAME
ND MY$PFX,'DMP'		;MESSAGE PREFIX
ND LN$ACT,^D50		;SIZE OF ACTION LIST
ND LN$CMD,^D20		;SIZE OF BUFFER TO REMEMBER COMMANDS IN
	MX$CMD==<LN$CMD*5>-1 ;MAX # CHARS IN COMMAND (LEAVE NULL ON END)
ND LN$TTL,^D30		;LENGTH OF TITLE BLOCK (.NMUL IN SCAN IS THIS LONG)
ND DF$BFZ,^D1024	;DEFAULT BUFFERSIZE IF NONE GIVEN
ND FT$SEG,0		;1 = ALL EXECUTABLE CODE GOES IN HIGH SEGMENT
			;0 = ONLY PUT SCAN IN HIGH SEGMENT AND THROW
			;    IT AWAY WHEN RUNNING
ND FT$OPT,1		;1 = SCAN SWITCH.INI FOR SWITCHES ALSO
ND FT$PHX,1		;1 = INCLUDE /IREAD SWITCH (FOR UI PHYSICS)
ND FT$WLD,1		;1 = ALLOW INPUT WILDCARDING
ND FT$ISD,1		;1 = INCLUDE INSTRUCTION SET DUMP

	    TWOSEG
IFN FT$SEG,<RELOC 400000>
IFE FT$SEG,<RELOC 0>
;DEFINE THE ACCUMULATORS

DEFINE AC$ (X)
<X=ZZ
ZZ==ZZ+1
X=X>

ZZ==0

AC$ (F)		;FLAGS
AC$ (T1)	;T1-4 ARE TEMPORARY
AC$ (T2)
AC$ (T3)
AC$ (T4)
AC$ (P1)	;P1-4 ARE PERMANENT AND MUST BE PRESERVED
AC$ (P2)
AC$ (P3)
AC$ (P4)
AC$ (A)		;ACTION LIST POINTER
AC$ (DC)	;LH=DEVCHR LH FOR INPUT DEVICE
		;RH=DEVCHR LH FOR OUTPUT DEVICE
AC$ (W)		;AOBJN PTR TO DATA DURING DUMP
AC$ (M)		;CURRENT DUMP MODE INDEX
AC$ (L)		;# WORDS/LINE IN CURRENT DUMP MODE
AC$ (Q)		;# CHARACTER POSITIONS/WORD IN CURRENT DUMP MODE
	P=17	;PUSHDOWN LIST POINTER
	C=P4	;CHARACTER FROM SCAN
	N=P3	;NUMBER OR WORD FROM SCAN
	E1=P3	;USED IN FLOATING POINT OUTPUT
	E2=P4	;DITTO
	E3=A	;MORE
	E4=DC	;AND MORE
	E5=W	;AND THE LAST
SUBTTL	FLAG DEFINITIONS

;FLAGS IN LH OF F

DEFINE FLAG$ (FLG)
<FL$'FLG==ZZ
ZZ==ZZ_-1
FL$'FLG==FL$'FLG> 

ZZ==(1B0)

FLAG$ (FOR)	;1 = DO FORTRAN INPUT
	$FLFOR==(FL$FOR)	;LEFT HANDED VALUE
IFN FT$PHX,<
FLAG$ (PHY)	;1 = DO IREAD (PHYSIX) INPUT
	$FLPHY==(FL$PHY)	;LEFT HANDED VALUE
>;END IFN FT$PHX
IFE FT$PHX,<FL$PHY==0>		;DUMMY DEFINITION IF FEATURE TURNED OFF
FLAG$ (SUM)	;1 = /SUMMARY
	$FLSUM==(FL$SUM)	;LEFT HANDED VALUE
FLAG$ (TOT)	;1 = /TOTALS
	$FLTOT==(FL$TOT)	;LEFT HANDED VALUE
FLAG$ (OMI)	;1 = OMIT LINE NUMBERS (UNFORMATTED DUMP FOR ASCII)
	$FLOMI==(FL$OMI)	;LEFT HANDED VALUE
FLAG$ (ITY)	;1 = /IFTYP
	$FLITY==(FL$ITY)	;LEFT HANDED VALUE
FLAG$ (IND)	;1 = /INDUSTRY
	$FLIND==(FL$IND)	;LEFT HANDED VALUE
FLAG$ (OUT)	;1 = OUTPUT SPEC HAS BEEN ALLOCATED
FLAG$ (NEG)	;1 = CURRENT # IS NEGATIVE IN INTFMT, FLTFMT
FLAG$ (TMP)	;GENERAL TEMPORARY FLAG (NOT SAVED OVER CALLS)
FLAG$ (MNP)	;1 = DOING FILE POSITIONING IN FORTRA/IREAD MODE
FLAG$ (EOT)	;END-OF-TAPE FLAG (2 EOFS IN A ROW)
FLAG$ (OLY)	;1 = THERE IS A /ONLY IN EFFECT
FLAG$ (FL2)	;TEMPORARY FLAG
FLAG$ (OPN)	;1 = OUTPUT FILE IS OPEN
FLAG$ (RDX)	;1 = A /RADIX WAS GIVEN
FLAG$ (IOF)	;FLAG FOR USE IN XCTIO AND BELOW
FLAG$ (ODN)	;OUTPUT HAS BEEN DONE

FL$SCN==FL$FOR!FL$PHY!FL$SUM!FL$TOT!FL$OMI!FL$IND ;FLAGS TO CLEAR AT CLRANS
FL$SCN==FL$SCN!FL$OUT!FL$ITY!FL$RDX

ZZ==1B18		;OVER TO THE RIGHT HALF

FLAG$ (POS)	;1 = /POSITION SWITCH
;I/O CHANNELS

;0	USED BY HELPER
INPC==1	;INPUT CHANNEL
OUTC==2	;OUTPUT CHANNEL

ATSIGN==(1B13)		;I/O SWITCH FLAG FOR OPENIO

;MISCELLANEOUS BITS AND STUFF

$OKDVI==DV.MTA!DV.DIR			;INPUT CAN BE MTA OR DIRECTORY DEVICE
$OKDVO==DV.MTA!DV.DIR!DV.TTY!DV.LPT	;OUTPUT CAN BE ONE OF THESE
CW$ANY==3000		;FORTRAN BINARY ANY LSCW PATTERN
CW$1O3==1000		;FORTRAN BINARY LSCW TYPE 1 OR 3 PATTERN
CW$TY3==2000		;FORTRAN BINARY LSCW TYPE 3 PATTERN

;FLAGS AND BITS FOR SWTCHS MACRO

FS$XXX==FS.NFS!FS.LRG!FS.NUE!FS.VRQ!FS.OBV!FS.NOS!FS.NCM ;BITS USED BY SCAN
			;SEE SCNMAC.MAC FOR DESCRIPTION OF ABOVE BITS
FS$XTR==1B17		;THIS SWITCH CAN TAKE EXTRA ARGUMENTS (/BACKSP:F:R)
FS$NVL==1B16		;THIS SWITCH NEVER TAKES A VALUE
FS$INP==1B15		;THIS SWITCH IS INPUT ONLY
FS$OUT==1B14		;THIS SWITCH IS OUTPUT ONLY

;DEFINE THE FUNCTIONS

FN$END==-2		;END OF ALL FUNCTIONS -- TERMINATE DUMP
FN$INP==-1		;ALL FUNCTIONS FOLLOWING THIS ARE INPUT ONLY

DEFINE FUNCTS
<X (<MOD,ONL,DMP,BSP,SKP,REW,RIB>)>

DEFINE X(A)
<IRP A,<FN$'A==ZZ
	ZZ==ZZ+1>>

ZZ==1			;FUNCTIONS GO FROM 1-HIGHEST

FUNCTS			;DEFINE THE FUNCTIONS

;ALL POSITIONING FUNCTIONS MUST BE BETWEEN BSP AND REW

FN$TP1==FN$BSP		;FIRST LEGAL POSITIONING FUNCTION
FN$TPX==FN$REW		;LAST LEGAL POSITIONING FUNCTION

;OPDEFINES

OPDEF	CALL	[PUSHJ	P,]	;SUBROUTINE CALL
SUBTTL	ERROR MACRO DEFINITIONS

;ERROR.	($FLGS,$PFX,$MSG)
;
;$FLGS 	IS THE COMBINITATION OF THE FOLLOWING BITS:

	EF$ERR==0	;ERROR--PREFIX MSG WITH ?, RETURN CONTROL AFTER CALL
	EF$FTL==400	;FATAL ERROR--ABORT AND RESTART
	EF$WRN==200	;WARNING MESSAGE--CONTINUE
	EF$INF==100	;INFORMATIVE MESSAGE--CONTINUE
	EF$NCR==40	;NO FREE CRLF AFTER MESSAGE

DEFINE ETYP ($TYP)
<ZZ==ZZ+1
EF$'$TYP==ZZ>

ZZ==0		;TYPE CODES ARE FROM 1-37

ETYP (DEC)	;TYPE T1 IN DECIMAL AT END OF MESSAGE
ETYP (OCT)	;TYPE T1 IN OCTAL AT END OF MESSAGE
ETYP (SIX)	;TYPE T1 IN SIXBIT AT END OF MESSAGE
ETYP (PPN)	;TYPE T1 AS A PPN AT END OF MESSAGE
ETYP (STR)	;T1 PTS TO ASCIZ STR TO TYPE AT END OF MESSAGE
ETYP (FIL)	;T1 PTS TO SCAN FILE BLOCK TO TYPE AT END OF MSG
	EF$MAX==ZZ	;MAX ERROR TYPE

IFG ZZ-37,<PRINTX ?TOO MANY ERROR TYPES>

;$PFX IS THE 3-LETTER PREFIX FOR THE MESSAGE
;$MSG IS THE MESSAGE ITSELF

NOOP==	(CAI)		;DEFINE NO-MEMORY-REFERENCE RIGHT-HAND NOOP

DEFINE	ERROR.	($FLGS,$PFX,$MSG)
<CALL	EHNDLR
XWD NOOP+<$FLGS>,[''$PFX'',,[ASCIZ @$MSG@ ] ]
>

;WARN.	FLGS,PFX,MSG

DEFINE	WARN.	($FLGS,$PFX,$MSG)
<ERROR.	EF$WRN!$FLGS,$PFX,$MSG>

;INFO.	FLGS,PFX,MSG

DEFINE	INFO.	($FLGS,$PFX,$MSG)
<ERROR.	EF$INF!$FLGS,$PFX,$MSG>
;SAVE$ SAVES DATA ON THE STACK

DEFINE	SAVE$	(X)
<XLIST
IRP X,<PUSH P,X>
LIST>

;RESTR$ RESTORES DATA FROM THE STACK

DEFINE	RESTR$	(X)
<XLIST
IRP X,<POP P,X>
LIST>

;MACRO TO ALLOCATE STORAGE IN THE LOW SEGMENT DATA BASE

DEFINE	U ($NAME,$WORDS<1>)
<$NAME:	BLOCK	$WORDS>

;STRNG$ (STRING) SENDS STRING TO OUTPUT THROUGH .TSTRG

DEFINE STRNG$ (S)
<MOVEI	T1,[ASCIZ \S\]
CALL	.TSTRG##>

;ASCIZ$ (STRING) CREATES XLISTED ASCIZ STRING TO KEEP LISTING PRETTY

DEFINE ASCIZ$ (S)
<XLIST
ASCIZ \S\
LIST>
;HIGH$ SWITCHES TO HIGH SEGMENT IF FT$SEG==0

DEFINE HIGH$
<IFE FT$SEG,<IFE CSEG$,<HILOC$==.
			CSEG$==-1
			RELOC	LOLOC$>>
>

;LOW$ SWITCHES TO LOW SEGMENT IF FT$SEG==0

DEFINE LOW$
<IFE FT$SEG,<IFN CSEG$,<LOLOC$==.
			CSEG$==0
			RELOC	HILOC$>>
>

;RELOC$ SETS UP LOLOC$ AND CSEG$ INITIALLY

DEFINE RELOC$
<IFE FT$SEG,<LOLOC$==400000	;;POINT LOLOC$ AT HIGH SEGMENT
	     CSEG$== 0>>	;START OUT IN THE LOW SEGMENT (CSEG$=0)

;LIT$ FORCES OUT LITERALS IN CURRENT SEGMENT

DEFINE LIT$
<XLIST
LIT
LIST>
SUBTTL	MAIN PROGRAM

RELOC$

;PROGRAM ENTRY POINT

DUMPR:	TDZA	T1,T1		;NOT CCL
	MOVEI	T1,1		;CCL
	MOVEM	T1,OFFSET	;SAVE FOR SCAN
IFE FT$SEG,<	;NEED TO SAVE THIS STUFF
	SKIPE	SAVRUN		;SAVED UUO ARGS?
	 JRST	RUNSVD		;YES
	MOVEM	.SGNAM,SGNAM
	MOVEM	.SGPPN,SGPPN
	MOVEM	.SGDEV,SGDEV
	MOVEM	.SGLOW,SGLOW
	SETOM	SAVRUN

RUNSVD:>;END IFE FT$SEG
RESTRT:	STORE	17,0,16,0	;CLEAR ACS
	STORE	17,FW$ZER,LW$ZER,0 ;AND STORAGE
	RESET			;STOP ALL I/O
	SKIPA	P,.+1		;SETUP PDP
INIPDP:	IOWD	LN$PDL,PDLIST
	CALL	.RECOR##	;RESET CORE
IFE FT$SEG,<CALL UPSCN>		;MAKE SURE HISEG IS THERE
	MOVE	T1,ISCNBL	;BLOCK FOR .ISCAN
	CALL	.ISCAN##	;INIT THE SCANNER
	MOVEM	T1,ISCNVL	;SAVE FOR LATER
	SKIPN	OFFSET		;CCL ENTRY?
	SKIPE	TLDVER		;TOLD WHO I AM?
	 JRST	FILD.0		;YES
	STRNG$	<DUMPR %>
	MOVE	T1,.JBVER
	CALL	.TVERW##
	CALL	.TCRLF##
	SETOM	TLDVER
FILD.0:	CALL	SCNCMD		;SCAN A COMMAND
	TRZE	F,FL$POS	;WAS /POSITION GIVEN?
	 JRST	MTAPOS		;YES--GO DO IT
	SETO	P1,		;FLAG OUTPUT NOT OPEN YET
FILD.2:	CALL	OPNINP		;OPEN INPUT FILE
IFN FT$WLD,<JRST FILD.9>	;WILD SAYS ALL DONE
	AOSN	P1		;ONLY OPEN OUTPUT FILE FIRST TIME THRU
	CALL	OPNOUT		;AND OUTPUT FILE
IFE FT$SEG,<CALL DWNSCN>	;RELEASE HISEG WHILE RUNNING
	CALL	PROCMD		;PROCESS THE COMMAND
IFE FT$SEG,<CALL UPSCN>		;REGET HISEG IF WE LOST IT
	CALL	INPCLS		;CLOSE INPUT FILE
IFN FT$WLD,<
	SKIPG	LKWLFL		;ARE WILD FILES POSSIBLE (DTA/DSK)?
	 SKIPN	.WLDFL##	;YES--AND ARE THERE ANY WILD FILES?
	   JRST	FILD.9		;NO--GO FINISH UP
	MOVE	T1,ODVNAM	;YES--GET OUTPUT DEVICE NAME
	DEVTYP	T1,		;SEE IF IT IS SPOOLED
	 JRST	FILD.2		;ASSUME NOT
	TXNN	T1,TY.SPL	;IS IT SPOOLED?
	 JRST	FILD.2		;NO--JUST GO AHEAD
	CALL	OUTCLS		;YES--MAKE A NEW FILE
	CALL	OPNOUT		; ...
	JRST	FILD.2		;GO TO IT
>;END IFN FT$WLD
FILD.9:	CALL	OUTCLS		;CLOSE OUTPUT FILE
FILD.X:	CALL	.RUNCM##	;HANDLE /RUN IF SPECIFIED
	SKIPE	OFFSET		;EXIT 1, IF CCL ENTRY
	 CALL	.MONRT##	;
	JRST	RESTRT		;AND RESTART
IFE FT$SEG,<LIT$>		;FORCE OUT LOW SEGMENT LITERALS
SUBTTL	SCAN A COMMAND FROM THE USER

HIGH$			;TO HIGH SEGMENT IF FT$SEG=0

SCNCMD:	MOVE	T1,TSCNBL	;FOR .TSCAN
	CALL	.TSCAN##	;SCAN THE COMMAND
IFN FT$OPT,<
	MOVE	T1,OSCNBL	;GET OSCAN ARG BLOCK
	CALL	.OSCAN##	;SCAN SWITCH.INI FOR SOME SWITCHES
>;END IFN FT$OPT

IFN FT$WLD,<
	MOVEI	T1,INPSPC	;SETUP PTR FOR WILD
	MOVEM	T1,WLDFIR	;...
>;END IFN FT$WLD
	TRNN	F,FL$POS	;/POSITION?
	PJRST	CHKCMD		;CHECK COMMAND FOR GOODNESS
	 POPJ	P,		;YES--WILL CHECK GOODNESS LATER

;ARG BLOCK FOR .ISCAN

ISCNBL:	XWD 5,	.+1
	IOWD	N$CMDS,CMDLST
	XWD	OFFSET,MY$PFX
	XWD	TTINPT,0	;MY INPUT SO WE CAN REMEMBER CMD
	EXP	0
	XWD	DOPRMP,0

;ARG BLOCK FOR .TSCAN

TSCNBL:	XWD 11,	.+1
	IOWD	SWTL,SWTN
	XWD	SWTD,SWTM
	XWD	0,SWTP
	EXP	-1
	XWD	CLRANS,CLRFIL
	XWD	AIN,AOUT
	EXP	0
	EXP	0
	EXP	STOSWT

IFN FT$OPT,<
OSCNBL:	XWD 4,	.+1
	IOWD	OPSWL,OPSWN
	XWD	OPSWD,OPSWM
	EXP	OPSWP
	EXP	-1
	EXP	0
>;END IFN FT$OPT
;SCAN CALLS HERE TO PROMPT WITH T1 NEGATIVE IF CONTINUATION PROMPT

DOPRMP:	SKIPL	T1		;FIRST OR CONT?
	SKIPA	T1,PRMPTM	;FIRST
	MOVSI	T1,'#  '	;CONTINUATION
	PJRST	.TSIXN##	;TYPE IT

PRMPTM:	XWD	MY$PFX,'>  '	;FIRST MSG

CMDLST:	EXP	MY$NAM		;MY NAME
	N$CMDS==.-CMDLST

;SCAN CALLS HERE TO GET COMMAND CHARACTERS FROM TTY

TTINPT:	INCHWL	C		;GET A CHARACTER
	SOSL	SCMDCT		;ROOM TO STORE IT?
	IDPB	C,SCMDBP	;YES
	POPJ	P,		;RETURN WITH CHARACTER IN C
SUBTTL	CHECK COMMAND FOR GOODNESS

CHKCMD:	CALL	OUTDFL		;DEFAULT OUTPUT SIDE
	CALL	INPDFL		;AND INPUT SIDE
	SKIPG	T1,USERDX	;/RADIX SPECIFIED
	SKIPA	T1,[EXP ^D8]	;NO--USE BASE 8
	TLO	F,FL$RDX	;REMEMBER /RADIX WAS SEEN FOR "OCTAL" DUMPING
	MOVEM	T1,USERDX	;...
	TLNN	F,FL$RDX	;SPECIFY /RADIX/
	 JRST	CHKC.0		;NO
	CAIL	T1,2		;YES--CHECK LEGALITY
	CAILE	T1,^D16		;...
	 ERROR.	EF$ERR!EF$DEC,IAR,<ILLEGAL ARG FOR /RADIX - >
	LSH	T1,-2		;DIVIDE BY 4
	MOVE	T1,WRDRDX(T1)	;GET A WIDTH FOR THE WORD
	MOVEM	T1,USRWID	;SAVE FOR DUMPING
CHKC.0:	SKIPG	T1,LINRDX	;WAS A LINE # RADIX SPECIFIED?
	 MOVEI	T1,LRXDEC	;NO--DEFAULT
	MOVEM	T1,LINRDX	;SET IT IN
	MOVE	T1,IDVNAM	;GET INPUT REAL NAME
	TLNE	DC,(DV.MTA)	;MTA?
	CAME	T1,ODVNAM	;SAME DEVICE?
	 JRST	CHKC.1		;NO--ONWARD
	 ERROR.	EF$SIX!EF$FTL,CUS,<CAN'T USE SAME MTA FOR INPUT AND OUTPUT - >
CHKC.1:
IFN FT$PHX,<
	TLC	F,FL$FOR!FL$PHY	;CAN'T HAVE /IREAD AND /FORTRAN
	TLCN	F,FL$FOR!FL$PHY	;SO MAKE SURE NOW
	 ERROR.	EF$FTL,MSE,<MODE SPECIFICATION ERROR - /IREAD + /FORTRAN>
>;END IFN FT$PHX
	TLC	F,FL$SUM!FL$TOT	;CAN'T HAVE /SUMMARY AND /TOTALS
	TLCN	F,FL$SUM!FL$TOT
	 ERROR.	EF$FTL,SWE,<SWITCH ERROR - /SUMMARY + /TOTALS>
	POPJ	P,		;COMMAND IS SANCTIFIED

WRDRDX:	EXP	^D37		;BASE 2
	EXP	^D19		;BASE 4
	EXP	^D13		;BASE 8
	EXP	^D13		;DUMMY
	EXP	^D10		;BASE 16

;DEFAULT INPUT SPECS

INPDFL:	SKIPN	T1,INPSPC+.FXDEV;DEFAULT DEVICE
	 MOVSI	T1,'DSK'	;IS DSK
	MOVEM	T1,INPSPC+.FXDEV
	DEVNAM	T1,		;SEE WHO IT IS
	 JRST	ILLIDV
	MOVEM	T1,IDVNAM
	DEVCHR	T1,		;GET BITS
	TLNN	T1,($OKDVI)	;CAN I USE IT?
	 JRST	ILLIDV		;NO
	HLL	DC,T1		;YES--SAVE DEVCHR BITS
	TLNE	DC,(DV.MTA)	;IS DEVICE A MAGTAPE?
	 JRST	INPD.1		;YES--CLEAR FILENAME AND EXTENSION
	TLZE	F,FL$IND	;NO--CLEAR /INDUSTRY IF GIVEN
	WARN.	0,IND,</INDUSTRY NO-OP ON NON-MTA DEVICE>
	MOVE	T1,[SIXBIT /DUMPIT/] ;DEFAULT NAME
	SETO	T2,
	SKIPN	INPSPC+.FXNAM
	 MOVEM	T2,INPSPC+.FXNMM
	SKIPN	INPSPC+.FXNAM
	 MOVEM	T1,INPSPC+.FXNAM
	HRLOI	T1,'DAT'	;AND EXTENSION
	MOVX	T2,FX.NUL	;GET NULL EXTENSION BIT
	TDNE	T2,INPSPC+.FXMOD;WAS ANYTHING SET FOR EXTENSION?
	 MOVEM	T1,INPSPC+.FXEXT;NO--USE A DEFAULT
	POPJ	P,

;HERE IF DEVICE SEEMS TO BE A MAGTAPE

INPD.1:	TLNE	DC,(DV.TTY)	;SEE IF IT IS ALSO A TTY (IE NUL:)
	TLZ	DC,(DV.MTA)	;YES--MAKE SURE WE DON'T TO MAGTAPE OPS
	SETZM	INPSPC+.FXNAM	;CLEAR NAME
	SETZM	INPSPC+.FXNMM	;AND MASK
	SETZM	INPSPC+.FXEXT	;AND EXTENSION
	SETZM	INPSPC+.FXDIR	;AND DIRECTORY
	POPJ	P,		;DONE

ILLODV:	SKIPA	T1,[EXP OUTSPC]	;ILLEGAL OUTPUT DEVICE
ILLIDV:	MOVEI	T1,INPSPC	;ILLEGAL INPUT DEVICE
	ERROR.	EF$FTL!EF$FIL,IDV,<ILLEGAL DEVICE >
;HERE TO DEFAULT OUTPUT SPECIFICATION

OUTDFL:	MOVX	T2,FX.NDV	;NULL DEVICE FLAG
	TDNN	T2,OUTSPC+.FXMOD;WAS IT REALLY A NULL DEVICE?
	 SKIPN	T1,OUTSPC+.FXDEV;NO--PICK UP DEVICE IF GIVEN
	 MOVSI	T1,'LPT'	;YES--USE DEFAULT
	MOVEM	T1,OUTSPC+.FXDEV
	DEVNAM	T1,		;SEE WHO IT REALLY IS
	 JRST	ILLODV		;NOT ONE I KNOW
	MOVEM	T1,ODVNAM	;SAVE REAL NAME
	DEVCHR	T1,		;SEE WHAT SORT OF DEVICE IT IS
	TLNN	T1,($OKDVO)	;A DEVICE I LIKE?
	 JRST	ILLODV		;NO
	HLR	DC,T1		;SAVE DEVICE CHARACTERISTICS
	MOVE	T1,[SIXBIT /DUMPED/] ;DEFAULT FILENAME
	SETO	T2,		;AND MASK
	SKIPN	OUTSPC+.FXNAM	;NAME GIVEN?
	 MOVEM	T2,OUTSPC+.FXNMM;NO--USE MY DEFAULT
	SKIPN	OUTSPC+.FXNAM
	 MOVEM	T1,OUTSPC+.FXNAM
	HRLOI	T1,'LPT'	;FINALLY THE EXTENSION
	SKIPN	OUTSPC+.FXEXT
	MOVEM	T1,OUTSPC+.FXEXT
	POPJ	P,
SUBTTL	SWITCH TABLE

DEFINE	SWTCHS,<
SP *BACKSP,FN$BSP,.SWDEC##,MTN,FS$XTR!FS.VRQ
SP BLOCK,S.BLKF,.SWDEC##,BKF,FS.NUE
SP BUFSIZ,BUFSIZ,.SWDEC##,BFZ,FS.NUE
SP *DUMP,FN$DMP,.SWDEC##,MTN,FS$XTR!FS$INP!FS.VRQ
SL *ERROR,FLERR,ERR,ERRCON,FS.NUE
SS *FORTRA,<POINTR(F,$FLFOR)>,1,FS.NUE
SS IFTYP,<POINTR(F,$FLITY)>,1,FS.NUE
SS INDUST,<POINTR(F,$FLIND)>,1,FS$INP!FS.NUE
IFN FT$PHX,<SS *IREAD,<POINTR(F,$FLPHY)>,1,FS$INP!FS.NUE>
SL LINRDX,LINRDX,LRX,LRXDEC,FS.NUE
SL *MODE,FN$MOD,MOD,MODOCT,FS$XTR!FS$OUT
SP MTBUF,NMTBUF,.SWDEC##,MBF,FS.NUE
SS *NORETR,FLNTRY,1,FS$INP!FS.NUE
SS OMIT,<POINTR(F,$FLOMI)>,1,FS$OUT!FS.NUE
SP *ONLY,FN$ONL,.SWDEC##,ONL,FS$XTR!FS$INP
SS *POSIT,<POINTR(F,FL$POS)>,1,FS.NUE
SP RADIX,USERDX,.SWDEC##,RDX,FS$OUT!FS.NUE
SS *REWIND,FN$REW,FN$REW,FS$NVL
SS RIB,FN$RIB,FN$RIB,FS$NVL
SP *SKIP,FN$SKP,.SWDEC##,MTN,FS$XTR!FS.VRQ
SS SUMMAR,<POINTR(F,$FLSUM)>,1,FS$OUT!FS.NUE
SP TITLE,<POINT ^D65-LN$TTL,TITLEB>,.SWASQ##,,FS.NUE
SS *TOTALS,<POINTR(F,$FLTOT)>,1,FS$OUT!FS.NUE
SP *WIDTH,FLWIDT,.SWDEC##,WID,FS$OUT!FS.NUE
>


DM (BFZ,^D4096,^D2048,^D1024)
DM (BKF,177777,^D80,^D80)
DM (MBF,^D10,^D3,^D3)
DM (MTN,177777,177777,177777)
DM (ONL,177777,0,0)
DM (RDX,^D16,^D8,^D8)
DM (WID,^D132,^D80,^D80)
KEYS (ERR,<CONTIN,IGNORE,QUERY>)
KEYS (MOD,<ASCII,BYTE,EBCDIC,FLOAT,HALF,HEX,INTEGE,OCTAL,SIXBIT,SYMBOL>)
KEYS (LRX,<DECIMA,HEX,OCTAL>)

;NOW EXPAND THE SWITCH TABLE

DOSCAN (SWT)
SUBTTL	SWITCH TABLE FOR OPTION SCAN

IFN FT$OPT,<

DEFINE SWTCHS,<
SP BUFSIZ,BUFSIZ,.SWDEC##,BFZ,FS.NUE
SL ERROR,FLERR,ERR,ERRCON,FS.NUE
SS IFTYP,<POINTR(F,$FLITY)>,1,FS.NUE
SL LINRDX,LINRDX,LRX,LRXDEC,FS.NUE
SP MTBUF,NMTBUF,.SWDEC##,MBF,FS.NUE
SP WIDTH,FLWIDT,.SWDEC##,WID,FS.NUE
>

DOSCAN (OPSW)
>;END IFN FT$OPT
SUBTTL	COMMAND SCANNING SUBROUTINES

AIN:
	SKIPE	INPSPC+.FXDEV	;ALREADY BEEN HERE?
	 ERROR.	EF$FTL,MIS,<MULTIPLE INPUT SPECIFICATIONS ILLEGAL>
	SKIPN	DUMPFL		;SEEN A /DUMP?
	 CALL	HOLDMP		;NO--SET TO DUMP ENTIRE WHATEVER
	HRROI	T1,FN$END	;SEND END OF LIST
	CALL	PUTACT		;...
	MOVEI	T1,INPSPC	;GET ADDRESS
ALEN:	MOVEI	T2,.FXLEN	;AND SIZE
	POPJ	P,
AOUT:
	SKIPE	OUTSPC+.FXDEV	;BEEN HERE?
	 ERROR.	EF$FTL,MOF,<MULTIPLE OUTPUT FILES ILLEGAL>
	HRROI	T1,FN$INP	;SET END OF OUTPUT FUNCTIONS
	CALL	PUTACT		;SEND TO LIST
	TLO	F,FL$OUT	;SET OUTPUT SPEC ALLOCATED
	MOVEI	T1,OUTSPC
	PJRST	ALEN

;SCAN CALLS HERE TO CLEAR ALL ANSWERS

CLRANS:	SKIPA	A,.+1		;LOAD UP ACTION PTR
INIACT:	IOWD	LN$ACT,ACTLST
	TLZ	F,FL$SCN	;CLEAR SCAN FLAGS IN F
	STORE	T1,SCN$FZ,SCN$LZ,0 ;CLEAR WHAT SHOULD BE ZERO
	STORE	T1,SCN$FO,SCN$LO,-1 ;MINUS 1 WHAT SHOULD BE MINUS 1
	MOVE	T1,[POINT 7,CMDBFR] ;INIT PTR TO STORE COMMAND
	MOVEM	T1,SCMDBP	;...
	MOVEI	T1,MX$CMD	;AND COUNTER
	MOVEM	T1,SCMDCT	;...
	POPJ	P,

;SCAN CALLS HERE TO CLEAR FILE ANSWERS

CLRFIL:
	POPJ	P,

;CALL TO DUMP WHOLE TAPE

HOLDMP:	MOVEI	T1,FN$DMP	;FUNCTION
	HRLOI	T2,777777	;A RIDICULOUSLY LARGE FILE/RECORD COUNT
				;(USE NEG. # SO IF DSK INPUT WE KNOW
				; NO /DUMP AND THEN DUMP WHOLE FILE)
	PJRST	PUTACT		;STOW AWAY AND RETURN
SUBTTL	STORE SWITCHES

;SCAN CALLS HERE TO STORE SOME SWITCHES
;N=VALUE, T2=PTR (FN$XXX), T3=FLAGS (FS$XXX), P1=SWITCH INDEX

STOSWT:	TLNN	T3,(FS$OUT)	;OUTPUT ONLY?
	 JRST	STOSWA		;NO
	TLNE	F,FL$OUT	;YES--OUTPUT ALLOCATED?
	 JRST	E$$OSI		;NO--BOMB
STOSWA:	TLNN	T3,(FS$INP)	;INPUT ONLY?
	 JRST	STOSWB		;NO
	TLNN	F,FL$OUT	;YES--OUTPUT ALLOCATED?
	 JRST	E$$ISO		;NO--BOMB
STOSWB:	TLNE	T3,(FS$NVL)	;NEVER TAKE A VALUE?
	 JRST	SWTST0		;YES--THATS CORRECT
	CAIN	T2,FN$MOD	;THIS /MODE?
	 JRST	STOMOD		;YES--DO DIFFERENTLY
	TLNE	T3,(FS$XTR)	;TAKE EXTRA ARGS?
	CAIE	C,":"		;YES--ARE THEY THERE?
	 JRST	SWTST0		;NO--JUST STORE
	SAVE$	<N,T2>		;YES--SAVE VALUE, AND FUNCTION
	CALL	.DECNW##	;READ SECOND VALUE
	RESTR$	<T1,T2>		;GET FUNCTION AND VALUE IN RIGHT ACS
	MOVSS	T2		;POSITION FILE COUNT IN LH
	HRR	T2,N		;AND RECORD COUNT IN RH
	PJRST	PUTACT		;PUT ON ACTION LIST AND RETURN

SWTS0A:	MOVEI	N,1		;NEVER TAKES A VALUE,MAKE SURE IT GETS DONE 1 X
SWTST0:	MOVE	T1,T2		;POSITION FUNCTION
	HRRZ	T2,N		;AND VALUE
;	PJRST	PUTACT		;STORE PARAMS AND RETURN

;PUTACT -- STORE PARAMETERS IN ACTION LIST
;CALL:	MOVE	T1,<FUNCTION>
;	MOVE	T2,<VALUE>
;	CALL	PUTACT

PUTACT:	PUSH	A,T1		;STORE FUNCTION
	PUSH	A,T2		;AND VALUE
	CAIN	T1,FN$DMP	;THIS THE /DUMP?
	 SETOM	DUMPFL		;YES--SAY WE HAVE ONE
	POPJ	P,

STOMOD:	CAIE	N,MODBYT	;/MODE:BYTE?
	JRST	SWTST0		;NO--DO NORMALLY

	CAIE	C,":"		;MUST HAVE A VALUE
	 ERROR.	EF$FTL,BRB,</BYTE REQUIRES BYTESIZE>
	SAVE$	<N,T2>		;SAVE MODBYT, FN$MOD
	CALL	.DECNW##	;READ BYTESIZE
	RESTR$	<T1,T2>		;FN$MOD IN T1, MODBYT IN T2
	CAILE	N,0		;CAN'T VERY WELL HAVE NEGATIVE BYTE SIZES
	CAILE	N,^D36		;OR GREATR THAN ONE WORD
	 JRST	E$$IBS		;SO TELL HIM ITS ILLEGAL AND QUIT
	HRL	T2,N		;PUT BYTESIZE IN LH
	 PJRST	PUTACT		;SET ON ACTION LIST AND RETURN
E$$IBS:	MOVE	T1,N		;POSITION TO TELL USER WHAT IS ILLEGAL
	ERROR.	EF$FTL!EF$DEC,IBS,<ILLEGAL BYTE SIZE - >

E$$OSI:	MOVE	T1,SWTN(P1)	;OUTPUT SWITCH ON INPUT SIDE
	ERROR.	EF$FTL!EF$SIX,OSI,<OUTPUT SWITCH ILLEGAL ON INPUT - >
E$$ISO:	MOVE	T1,SWTN(P1)	;INPUT SWITCH ON OUTPUT SIDE
	ERROR.	EF$FTL!EF$SIX,ISO,<INPUT SWITCH ILLEGAL ON OUTPUT - >
SUBTTL	DO /POSITION SWITCH

MTAPOS:	CALL	CKPOSC		;CHECK FOR ILLEGAL FUNCTIONS, NEVER RETURN IFSO
	MOVE	T1,INPSPC+.FXDEV;GET INPUT NAME
	DEVCHR	T1,		;SEE WHAT IT IS
	TXNN	T1,DV.MTA	;IS IT A MAGTAPE?
	 JRST	ILLIDV		;NO--GO QUIT NOW
	CALL	INWLDO		;OPEN THE UNIT
	 JRST	RESTRT		;SNH
	CALL	MNPXCI		;DO MTA MANIPULATIONS
	CALL	INPCLS		;CLOSE INPUT
	JRST	FILD.X		;GO DO RUN COMMAND, EXIT 1, OR RESTRT

;ROUTINE TO CHECK FUNCTION LIST FOR BADDIES

CKPOSC:	MOVEI	T1,ACTLST	;POINT AT THE LIST
CKPS.1:	HRRZ	T2,(T1)		;GET A FUNC
	ADDI	T1,2		;MOVE TO NEXT FUNCTION
	CAIN	T2,FN$END	;IS THIS THE END?
	 POPJ	P,		;YES
	MOVSI	T3,-N$MTAF 	;SETUP AOBJN
	CAME	T2,LGLMTF(T3)	;IS THIS IT?
	AOBJN	T3,.-1		;NO--CHECK ALL
	JUMPL	T3,CKPS.1	;GO CHECK NEXT IF THIS ONE OK
	ERROR.	EF$FTL,IPF,<ILLEGAL POSITIONING FUNCTION>

;TABLE OF LEGAL POSITIONING FUNCTIONS

LGLMTF:	EXP	FN$BSP,FN$SKP,FN$REW,FN$DMP ;FN$DMP IS IGNORED LATER
	N$MTAF==.-LGLMTF

;ROUTINE TO WHIP THROUGH ACTLST AND EXECUTE MTA FILE POSITIONING ONLY
;THE LIST MUST CONTAIN ONLY FILE POSITIONING COMMANDS AND FN$END

MNPXCI:	CALL	.SAVE4##	;PRESERVE 4 REGISTERS
	MOVEI	P1,(Z INPC,)	;SETUP THE CHANNEL
	MOVEI	P2,ACTLST	;POINT AT THE LIST
MNPX.2:	HRRZ	T1,(P2)		;GET NEXT THING
	CAIN	T1,FN$END	;IS THIS THE END?
	 POPJ	P,		;YES--ALL DONE
	HLRZ	P3,1(P2)	;GET POSSIBLE FILE COUNT
	HRRZ	P4,1(P2)	;AND POSSIBLE RECORD COUNT
	ADDI	P2,2		;MOVE TO NEXT THING
	JRST	@MNPDSP-FN$BSP(T1) ;DISPATCH

	EXP	MNPX.2		;IGNORE /DUMP
MNPDSP:	EXP	MNP.BS
	EXP	MNP.SK
	EXP	MNP.RW

MNP.RW:	MOVE	T1,[MTREW.]	;SETUP FUNCTION TO EXECUTE
	SETZ	T3,		;CLEAR COUNT
MNPXDG:	CALL	MNP.XX		;DO THE REWIND
	JRST	MNPX.2		;GO GET NEXT THING

;GET HERE WITH T1 HAVING MTAPE TO DO (MINUS CHAN), AND T3=# TIMES TO DO IT

MNP.XX:	TLO	T1,(P1)		;SETUP THE CHANNEL
	XCT	T1		;DO IT ONE TIME
	SOJG	T3,.-1		;DO IT ALL WE NEED TO
	POPJ	P,

MNP.SK:
MNP.BS:	SKIPLE	P4		;ANY RECORDS TO DO?
	PUSH	P,[EXP <MTBSR.>,<MTSKR.>]-FN$BSP(T1) ;YES--SETUP FOR IT
	SKIPLE	P3		;ANY FILES TO DO?
	PUSH	P,[EXP <MTBSF.>,<MTSKF.>]-FN$BSP(T1) ;YES--
MNP.BF:	SKIPG	T3,P3		;CHECK/PICKUP FILE ACTION
	 JRST	MNP.B1		;NO--CHECK RECORD ACTION
	POP	P,T1		;YES--GET MTAPE
	CALL	MNP.XX		;DO IT
MNP.B1:	SKIPG	T3,P4		;CHECK/PICKUP RECORD ACTION
	 JRST	MNPX.2		;NO--GET NEXT THING
	POP	P,T1		;YES--GET MTAPE
	JRST	MNPXDG		;GO DO IT AND LOOP FOR MORE ACTION
SUBTTL	WILD CARD HANDLING FOR INPUT FILE

IFN FT$WLD,<
;ROUTINE TO CALL .LKWLD AND OPEN/LOOKUP THE FILE PRESENTED
;CPOPJ IF NO FILE FOUND
;CPOPJ1 IF OPENED OK

INWLDO:	MOVE	T1,[XWD SVINOB,OPNBLK] ;RESET OPNBLK IN CASE NOT FIRST TIME
	BLT	T1,OPNBLK+.OPBUF
INWL.1:	MOVE	T1,LKWLDB	;GET THE ARG BLOCK
	CALL	.LKWLD##	;FIND A FILE TO DO
	 POPJ	P,		;CAN'T FIND ANYTHING
	MOVEM	T2,LKWLFL	;SAVE FLAG FOR LATER (IN CASE MTA)
	MOVEI	T1,.IOBIN	;USE BINARY MODE
	HRRM	T1,OPNBLK+.OPMOD
	MOVEI	T1,IBHR		;SETUP MY BUFFER HEADER ADDRESS
	MOVEM	T1,OPNBLK+.OPBUF
	OPEN	INPC,OPNBLK	;OPEN THE DEVICE
	 JRST	[CALL	E.DFO##	;REPORT OPEN ERROR
		JRST	INWL.1]	;KEEP GOING TILL .LKWLD SAYS DONE
	SKIPLE	LKWLFL		;DO WE NEED TO DO A LOOKUP?
	 JRST	$POPJ1		;NO--THEN WHY BOTHER (NOT DIR DEVICE)
	LOOKUP	INPC,LKPBLK	;FIND THE FILE
	 JRST	[CALL	E.DFL##	;REPORT ERROR
		JRST	INWL.1]	;AND KEEP LOOKING
	SKIPG	INPSPC+.FXFLM	;ENSURE .FXFLM IS RIGHT
	SETOM	INPSPC+.FXFLM	;SO .CHKTM WILL WORK WRIGHT
	CALL	.CHKTM##	;CHECK DATE/TIME CONSTRAINTS
	 JRST	INWL.1		;FAILED--GET NEXT FILE
	JRST	$POPJ1		;OK--SKIP BACK WITH THE FILE

LKWLDB:	XWD	5,.+1
	XWD	WLDFIR,0
	XWD	OPNBLK,LKPBLK
	XWD	.FXLEN,.RBTIM+1
	EXP	1B0+WLDPTR
	EXP	0
>;END IFN FT$WLD
IFE FT$SEG,<LIT$>
	LOW$			;TO LOW SEGMENT IF FT$SEG=0
SUBTTL	HIGH SEGMENT HANDLERS

IFE FT$SEG,<	;NOT NECESSARY IF LOAD ALL IN HIGH SEGMENT
;CALL DWNSCN TO REMOVE HIGH SEGMENT

DWNSCN:	SKIPN	.JBHRL		;SEG AROUND?
	POPJ	P,		;NO--DON'T DO CORE UUO NOW
	SAVE$	T1		;PRESERVE T1
	MOVSI	T1,1		;YES--GET RID OF IT
	CORE	T1,		;BYE/!
	 JFCL			;SNH
	JRST	TPOPJ		;RESTORE T1 AND RETURN

;CALL UPSCN TO REGET THE HIGH SEGMENT

UPSCN:	SKIPE	.JBHRL		;SCAN AROUND?
	 POPJ	P,		;YES--SKIP COSTLY GETSEG
	MOVEM	17,SAVAC+17	;GETSEG DESTROYS ACS
	MOVEI	17,SAVAC
	BLT	17,SAVAC+16	;SAVE ALL
SEGAGN:	MOVE	T1,SGDEV	;SETUP FOR GETSEG
	MOVE	T2,SGNAM
	MOVE	T3,SGLOW
	SETZB	T4,P2
	MOVE	P1,SGPPN
	MOVEI	P3,T1		;POINT AT THE BLOCK
	GETSEG	P3,
	SKIPA	T1,P3		;FAILED!--GET ERROR CODE IN T1
	JRST	[MOVSI	17,SAVAC
		BLT	17,17
		POPJ	P,]
	MOVE	P,INIPDP	;RESET PDP (WILL GET RESTORED IF WE GET SEG)
	ERROR.	EF$OCT!EF$ERR,CGH,<CAN'T GET HIGH SEGMENT, CODE = >
	EXIT	1,
	JRST	SEGAGN		;MAYBE IT WAS JUST LOST?
>;END IFE FT$SEG
SUBTTL	OPEN FILES

;CALL HERE TO OPEN INPUT FILE
;ALWAYS RETURN CPOPJ IF FT$WLD=0
;IF FT$WLD=1, IF NO FILE FOUND RETURN CPOPJ, ELSE RETURN CPOPJ1 WITH GOODIES

OPNINP:
IFE FT$WLD,<
	MOVEI	T1,INPSPC	;POINT AT THE SPEC
	CALL	OPENIO		;OPEN THE DEVICE (LOOKUP FILE IF NEEDED)
	CAI	INPC,IBHR(.IOBIN) ;
>;END IFE FT$WLD
IFN FT$WLD,<
	CALL	INWLDO		;OPEN INPUT FILE
	 POPJ	P,		;CAN'T FIND ANY--ALL DONE
	AOS	(P)		;SETUP TO SKIP BACK--WE HAVE A FILE
>;END IFN FT$WLD
	MOVS	T1,[XWD SVINOB,OPNBLK] ;SETUP TO SAVE OPEN/LOOKUP BLOCK
	BLT	T1,SVINLK+.RBTIM;COPY IT OVER
	MOVE	T1,LKPBLK+.RBSIZ;GET SIZE OF FILE IN WORDS
	LSH	T1,-7		;CVT TO BLOCKS
	AOJ	T1,		;...
	MOVEM	T1,IFILSZ	;SAVE FOR LATER (POSITIONING)
OPNI.A:	TLNN	DC,(DV.MTA)	;INPUT MTA?
	 JRST	OPNI.1		;NO
	CALL	.SAVE3##	;YES--SAVE REGISTERS
	MOVEI	P1,INPSPC	;POINT AT SPEC
	MOVEI	P2,INPC		;AND CHANNEL
	MOVEI	P3,INPC		;FOR MTCHR
	MTCHR.	P3,
	SETZ	P3,		;SNH
	CALL	SETCHR		;SET /DENSITY AND /PARITY
	TLNE	F,FL$IND	;/INDUSTRY?
	 MTIND.	INPC,		;YES--SETUP FOR IT
	SKIPLE	FLNTRY		;/NORETRY?
	 JRST	[GETSTS	INPC,T1	;YES--GET STATUS
		SETSTS	INPC,IO.NRC(T1) ;SET NO RETRY
		JRST	.+1]
OPNI.1:	SKIPG	T1,BUFSIZ	;/BUFSIZ GIVEN?
	 MOVEI	T1,DF$BFZ	;NO--USE A K
	MOVEM	T1,BUFSIZ	;SET IN CASE WE DEFAULTED
				;NOTE THAT .ALCBF WILL ADJUST BUFFER
				;TO 128. FOR DSK OR 127. FOR DTA
	HRLI	T1,6		;ASSUME DISK INPUT
	TLNN	DC,(DV.MTA)	;BUT SEE IF MAGTAPE
	 JRST	OPNI.2		;NO--SIX IS RIGHT
	SKIPG	T2,NMTBUF	;DID USER SPECIFY /MTBUF?
	 MOVEI	T2,2		;NO--USE 2
	HRLI	T1,(T2)		;SET CORRECT BUFFER COUNT
OPNI.2:	SKIPA	T2,.+1		;OTHER ALCBUF ARGWORD
	XWD	OPNBLK,IBHR
	CALL	.ALCBF##	;SETUP BUFFERS
	TLNN	DC,(DV.MTA)	;DSK OR DTA INPUT?
	 TLNN	F,FL$FOR!FL$PHY	;AND /IREAD OR /FORTRAN?
	 TLNE	F,FL$FOR	;BUT IF /FORTRAN ON TAPE
	  SKIPA	T1,BUFSIZ	;YES--NEED TO ALLOCATE FORBUF
	   POPJ	P,		;NO--WE ARE DONE
	CALL	.ALCOR##	;ALLOCATE FORTRA/IREAD BUFFER
	MOVEM	T1,FORADR	;SAVE FOR LATER USAGE
	POPJ	P,
;COME HERE TO CLOSE INPUT DEVICE

INPCLS:	CLOSE	INPC,
	RELEASE	INPC,
	SKIPE	T1,FORADR	;WAS THERE A FORTRA/IREAD ARRAY?
	CALL	.DECOR##	;YES--MAKE IT GO AWAY
	SETZM	FORADR		;CLEAR IN CASE 
	MOVEI	T1,IBHR
;	PJRST	TSTBHR		;FREE UP BUFFERS

;HERE TO FREE BUFFERS IF THEY WERE ALLOCATED

TSTBHR:	SKIPN	.BFADR(T1)	;USED?
	 POPJ	P,		;NO--QUIT NOW
	SAVE$	T1		;SAVE ADDRESS
	CALL	.FREBF##	;FREE BUFFERS
	RESTR$	T1		;RESTORE ADDRESS
	SETZM	.BFADR(T1)
	SETZM	.BFPTR(T1)
	SETZM	.BFCTR(T1)
	POPJ	P,

;HERE TO CLOSE OUTPUT FILE

OUTCLS:	TLZE	F,FL$ODN	;WAS ANY OUTPUT DONE?
	 TDZA	T1,T1		;YES--PRESERVE THE FILE
	  MOVEI	T1,CL.RST	;NO--MAKE FILE DISSAPPEAR
	CLOSE	OUTC,(T1)	;FINISH WRITING THE FILE
	RELEASE	OUTC,
	TLZ	F,FL$OPN	;NOT OPEN NOW
	MOVEI	T1,OBHR
	PJRST	TSTBHR
;HERE TO OPEN OUTPUT FILE

OPNOUT:	MOVEI	T1,OUTSPC	;SETUP
	CALL	OPENIO		;DO IT
	CAI	OUTC,@OBHR(.IOASC)
	TRNE	DC,(DV.MTA)	;IS OUTPUT DEVICE MTA?
	 JRST	OPNO.1		;NO
	CALL	.SAVE3##	;YES--SAVE P1-3
	MOVEI	P1,OUTSPC
	MOVEI	P2,OUTC
	MOVEI	P3,OUTC
	MTCHR.	P3,
	 SETZ	P3,		;...SNH
	CALL	SETCHR		;SET /DENSITY AND /PARITY
OPNO.1:	MOVSI	T1,6		;USE 6 BUFFERS
	TRNE	DC,(DV.MTA)	;UNLESS MTA
	 MOVSI	T1,2		;IN WHICH CASE USE 2
	SKIPA	T2,.+1		;
	XWD	OPNBLK,OBHR
	CALL	.ALCBF##
	OUTPUT	OUTC,		;DO DUMMY OUTPUT
	TLO	F,FL$OPN	;OUTPUT FILE IS OPEN FOR BUSINESS
	TLZ	F,FL$ODN	;NO OUTPUT DONE YET, THO
	POPJ	P,
SUBTTL	SET MAGTAPE CHARACTERISTICS

;SETCHR -- SET TAPE CHARACTERISTICS
;CALL:	MOVEI	P1,<SPEC ADDR>
;	MOVEI	P2,<CHANNEL>
;	MOVE	P3,<AC RESULT OF MTCHR. UUO>
;	CALL	SETCHR
;	*RETURN*

SETCHR:	LDB	T1,[POINTR (.FXMOD(P1),FX.DEN)] ;GET /DENSITY: VALUE
	JUMPE	T1,SETC.1	;JUMP IF NONE
	XCT	SETDEN(T1)	;SET THE DENSITY
	MOVE	T1,[XWD 3,T2]	;TAPOP. ARG
	MOVEI	T2,.TFDEN+.TFSET;FUNCTION
	MOVE	T3,P2		;CHANNEL
	CALL	DOTPOP		;DO TAPOP.
SETC.1:	LDB	T1,[POINTR(.FXMOD(P2),FX.PAR)] ;/PARITY: VALUE
	XCT	SETPAR(T1)	;SET THE PARITY
	POPJ	P,

SETDEN:	JFCL			;SNH
	CALL	DEN200		;200 BPI
	CALL	DEN556		;556 BPI
	MOVEI	T4,.TFD80	;800 BPI
	CALL	DEN160		;1600 BPI
	CALL	DEN625		;6250 BPI
	MOVE	T4,T1		;(6)
	MOVE	T4,T1		;(7)

DEN556:
DEN200:	TRNN	P3,MT.7TR	;MUST BE 7 TRACK
E$$ID9:	ERROR.	EF$FTL,ID9,<ILLEGAL DENSITY FOR 9-TRACK>
	MOVE	T4,T1		;SETUP DENSITY
	POPJ	P,

DEN625:
DEN160:	TRNE	P3,MT.7TR	;CAN'T BE 7 TRACK
E$$ID7:	ERROR.	EF$FTL,ID7,<ILLEGAL DENSITY FOR 7-TRACK>
	MOVE	T4,T1
	POPJ	P,

SETPAR:	JFCL			;ODD IS THE DEFAULT
	CALL	EVNPAR		;SET EVEN
EVNPAR:	MOVE	T1,[XWD 3,T2]	;ARGWORD
	MOVEI	T2,.TFPAR+.TFSET;FUNCTION
	MOVE	T3,P2		;CHANNEL
	MOVEI	T4,1		;EVEN PARITY
;	PJRST	DOTPOP		;DO AND RETURN
		;FALL THROUGH TO DOTPOP
;DOTPOP -- DO A TAPOP WITH ERROR REPORTING
;CALL:	MOVE	T1,[ARGBLOCK]
;	MOVEI	T2,<FUNCTION>
;	MOVE	T3,<TAPNAM,IOCHAN, OR SOMETHING JUST AS GOOD>
;	MOVE	T4,<ARG>
;	CALL	DOTPOP
;	*RETURN*

DOTPOP:	TAPOP.	T1,		;DO IT
	 CAIA			;FAILED--REPORT ERROR
	POPJ	P,		;OK

ETAPOP:	SAVE$	<T4,T3,T2,T1>	;SAVE ON PDL
	WARN.	EF$OCT!EF$NCR,TUF,<TAPOP. UUO FAILURE--CODE = >
	STRNG$	< - FN=>
	MOVE	T1,-1(P)	;GET FN (WAS IN T2)
	CALL	.TOCTW##
	CALL	.TCRLF##
	RESTR$	<T1,T2,T3,T4>
	POPJ	P,
SUBTTL	PROCESS THE COMMAND LIST

;THIS IS THE HEART OF THE DUMPR PROGRAM.  IT GETS THE FUNCTIONS OFF
;OF THE ACTION (COMMAND) LIST AND PROCESSES THEM.

PROCMD:	CALL	.SAVE4##	;SAVE P1-4
	CALL	DMPINI		;INITIALIZE
	MOVEI	A,ACTLST	;SETUP A TO POINT TO ACTION LIST
	TLZA	F,FL$OUT	;FLAG WE ARE ON OUTPUT SIDE OF THINGS
DMPINP:	 TLO	F,FL$OUT	;FLAG WE ARE ON INPUT SIDE OF THINGS
DMPLUP:	MOVE	T1,(A)		;GET A COMMAND
	HLRE	P1,1(A)		;GET LH OF ARG WORD (USUALLY FILE COUNT)
	HRRZ	P2,1(A)		;GET RH OF ARG WORD (USUALLY RECORD COUNT)
	ADDI	A,2		;MOVE TO NEXT ACTION
	JRST	@DMPDSP(T1)	;GO TO IT

	EXP	DMPEND		;(-2) END IT ALL
	EXP	DMPINP		;(-1) ALL POSITIONING SWITCHES FOLLOWING
				;     ARE FOR INPUT SIDE
DMPDSP:	HALT	.		;(0)  SHOULD NOT HAPPEN

DEFINE X(A)			;MACRO TO GENERATE REST OF TABLE
<IRP A,<EXP D$'A>>
	FUNCTS			;GENERATE REST OF TABLE
;INITIALIZE FOR THE COMMAND PROCESSING

DMPINI:	STORE	T1,RUN$FZ,RUN$LZ,0 ;CLEAR SOME THINGS
	TLNE	DC,(DV.MTA)	;IS INPUT MAGTAPE?
	 TLNE	F,FL$FOR	;AND NOT /FORTRAN?
	  JRST	DMPI.1		;NOT MTA OR MTA AND /FORTRAN
	MOVEI	T1,.TFSTA	;ATTEMPT TO DIVINE THE TAPE'S LOCATION
	MOVEM	T1,TAPOBL-3	;WITH A TAPOP.
	MOVEI	T1,INPC		;HOPE TAPUUO LIKES CHANNEL ARGS TODAY
	MOVEM	T1,TAPOBL-2	;...
	MOVE	T1,[XWD 5,TAPOBL-3] ;ARGWORD
	MTWAT.	INPC,		;FIRST MAKE SURE THE TAPE HAS STOPPED MOVING!
	TAPOP.	T1,		;ASK MONITOR WHERE THE TAPE IS
	 JFCL			;(IGNORE ERROR)
DMPI.1:	SETZB	M,W		;DEFAULT IS OCTAL MODE
	CALL	D$MSET		;SET UP L AND Q
	TLZ	F,FL$EOT!FL$OLY!FL$MNP ;CERTAINLY NOT END OF TAPE
	CALL	INIHDR		;OUTPUT INITIAL HEADER MESSAGE
	SKIPG	T1,S.BLKF	;GET BLOCKING FACTOR IN CASE EBCDIC
	 MOVEI	T1,AD.BKF	;NOT SPECIFIED--GET DEFAULT
	MOVEM	T1,S.BLKF	;SET IN CASE NEEDED
	MOVEM	T1,EBCKNT	;AND THE COUNTER ALSO
	POPJ	P,		;DONE

;DISPATCH TABLE FOR DUMPING WORDS

DMPWRD:	EXP	FMTOCT		; 0--RADIX 8
	EXP	O$ASCW		; 1--ASCII
	EXP	O$BYTW		; 2--BYTE
	EXP	E$$EIW		; 3--EBCDIC
	EXP	FMTFLO		; 4--FLOAT
	EXP	[HALT]		; 6--HALF (SNH)
	EXP	O$HEXW		; 5--HEX
	EXP	FMTINT		; 6--INTEGER
	EXP	FMTOCT		; 7--OCTAL
	EXP	O$SIXN		;10--SIXBIT
	EXP	O$SYMW		;11--SYMBOL

E$$EIW:	ERROR.	EF$FTL,EIW,<EBCDIC ILLEGAL WITHOUT /INDUSTRY>
SUBTTL	MAJOR DUMP LOOP

DUMPIT:	SOJGE	L,DUMP.1	;ROOM LEFT ON LINE?
	 CALL	D$NEWL		;NO--MAKE NEW LINE
	SOJ	L,		;DON'T FORGET TO COUNT WORD WE DUMP NOW
DUMP.1:	MOVE	T1,(W)		;GET A WORD
	CALL	D$WORD		;DUMP IN PROPER MODE
	AOBJN	W,DUMPIT	;DO ALL WORDS IN RECORD

DUMP.2:	SKIPG	P1		;FILES LEFT?
	 SOJLE	P2,DMPEND	;YES--ANY RECORDS LEFT?
DUMP$G:	CALL	GETBUF		;NEW BUFFER FULL
	JRST	DUMPEF		;END OF FILE
	TLZ	F,FL$EOT	;CLEAR EOT FLAG--WE SAW SOME DATA
	CALL	CHKTTY		;ATTEND TO TTY IF /IFTYP
	 JRST	DMPEND		;SAID TO KILL IT OFF
	CALL	RECHDR		;OUTPUT RECORD (BLOCK) HEADER
	TLNE	F,FL$SUM!FL$TOT	;/SUMMARY OR /TOTAL
	 JRST	DUMP.2		;YES--DONE WITH THIS RECORD
	TLNN	F,FL$OLY	;IS THERE A /ONLY IN EFFECT?
	JRST	DUMPIT		;CONTINUE DUMPING
OLYDMP:	MOVE	P3,ONLYLO	;GET LOW LIMIT
	MOVEI	T1,-1(P3)	;ADJUST WRDCNT
	ADDM	T1,WRDCNT	;TO REFLECT THE WORDS WE SKIPPED
	SOJLE	P3,OLYD.1	;JUMP IF WE HAVE SKIPPED ENOUGH
	AOBJN	W,.-1		;NO--SKIP MORE, BUT WATCH FOR END OF RECORD
	JRST	DUMP$G		;RAN OUT OF RECORD BEFORE LOW LIMIT REACHED

OLYD.1:	MOVE	P3,ONLYHI	;GET UPPER LIMIT
	SUB	P3,ONLYLO	;COMPUTE # WORDS TO DUMP
	SETO	L,		;FORCE A NEW LINE FIRST TIME THROUGH
OLYD.2:	SOJGE	L,OLYD.3	;TIME FOR NEW LINE?
	CALL	D$NEWL		;YES
	SUBI	L,1		;COUNT WHAT WE DO NOW
OLYD.3:	MOVE	T1,(W)		;GET A WORD
	CALL	D$WORD		;DUMP IN PROPER FORMAT
	SOJL	P3,DUMP.2	;JUMP IF DUMPED ENOUGH
	AOBJN	W,OLYD.2	;JUMP IF MORE WORDS IN RECORD
	JRST	DUMP.2		;END OF RECORD

;HERE TO START THE DUMP

D$DMP:	TLNE	DC,(DV.DIR)	;INPUT A DIRECTORY DEVICE?
	JUMPG	P1,E$$CDM	;NO FILES ALLOWED ON DIRECTORY DEVICE
	TLNN	DC,(DV.MTA)	;CHECK FOR MTA INPUT
	 JRST	D$DMP1		;NO--SKIP MESSAGE
	MOVEI	T1,[ASCIZ/[DMPIPT INITIAL POSITION OF TAPE IS FILE /]
	CALL	O$STRG		;SEND IT
	MOVE	T1,FILE		;GET FILE COUNT
	CALL	O$DECW		;SEND IIT
	MOVEI	T1,RECMS2	;<SP>RECORD<SP>
	CALL	O$STRG
	MOVE	T1,RECORD
	CALL	O$DECW
	CALL	RBRKNL		;CLOSE INFO
	CALL	FRCTYO		;MAKE IT SHOW IF TTY OUTPUT....KEEP USER HAPPY
D$DMP1:	JUMPGE	P1,DUMP$G	;JUMP IF FILE COUNT IS OK 
	TLNN	DC,(DV.MTA)	;NO--SEE IF MTA
	 TDZA	P1,P1		;NO--MAKE SURE FILE COUNT IS ZERO
	HRLOI	P1,377777	;YES--DO WHOLE TAPE (SEE HOLDMP)
	JRST	DUMP$G		;BEGIN TO DUMP
E$$CDM:	ERROR.	EF$FTL,CDM,<CANT DUMP MULTIPLE FILES ON DIRECTORY DEVICE>
SUBTTL	DUMP WORD ROUTINE

D$WORD:	TLNN	F,FL$IND	;IN /INDUSTRY MODE?
	 PJRST	@DMPWRD(M)	;NO--JUST GO DUMP THE SUCKER
	PJRST	@DMPINW(M)	;YES--DO IT THAT WAY

;HERE TO CONVERT IBM 360/370 FLOATING POINT WORD TO PDP10

INDFLO:	JUMPE	T1,FMTFLO	;ALL DONE IF ZERO
	SKIPL	T1		;SET NEGATIVE FLAG IF NEEDED
	 TDZA	T3,T3		;NO--FLAG POSITIVE
	  SETO	T3,		;YES--REMEMBER THAT
	SETZ	T2,		;CLEAR T2
	ROTC	T1,^D8		;SEPARATE EXPONENT AND MANTISSA
	SUBI	T2,^D64		;COMPUTE ACTUAL FRACTION
	ASH	T2,2		;MAKE PDP-10 EXPONENT BASE 2
	CAMGE	T2,[EXP -^D128]	;WAS IT TOO SMALL?
	 JRST	TOOSML		;YES--MAKE IT SMALLEST PDP-10 WORD
	CAILE	T2,^D127	;TOO BIG?
	 JRST	TOOBIG		;YES
	ADDI	T2,^D128	;ADD PDP EXPONENT BIAS
FLTROT:	ROTC	T1,-^D9		;REMAKE THE NUMBER
	FADRI	T1,(0.0)	;NORMALIZE IT
	JUMPE	T3,FMTFLO	;ALL DONE IF POSITIVE
	EXCH	T2,T1		;NEED TO NEGATE IT
	SETZ	T1,		;SO SUBTRACT IT FROM ZERO
	FSBR	T1,T2		;..
	JRST	FMTFLO		;DUMP PDP10 FLOATING PT NUMBER
TOOSML:	SETZ	T1,		;DO ZERO IF TOO SMALL
	JRST	FMTFLO		;OUTPUT A ZERO
TOOBIG:	MOVEI	T1,377		;MAKE LARGEST DEC10 NUMBER
	SETO	T2,		;...
	JRST	FLTROT

DMPINW:	EXP	FMTRDX		;OCTAL
	EXP	O$IASC		;EIGHT BIT ASCII
	EXP	O$BYTW		;BYTE
	EXP	O$EBCW		;EBCDIC
	EXP	INDFLO		;FLOATING POINT
	EXP	[HALT]		;HALFWORD (SNH)
	EXP	O$HEXI		;HEX 
	EXP	[ASH	T1,-4	;INTEGER--POSITION NUMBER
		JRST	FMTINT]	;AND DO IT
	EXP	FMTRDX		;OCTAL
	EXP	E$$SWI		;SIXBIT
	EXP	E$$SWI		;SYMBOL

E$$SWI:	ERROR.	EF$FTL,SWI,<SIXBIT/SYMBOL WITH /INDUSTRY ILLEGAL>
;HERE AT END OF FILE

DUMPEF:	TLNN	DC,(DV.DIR)	;DIRECTORY DEVICE?
	 TLOE	F,FL$EOT	;MTA--SET/CHEK EOT FLAG
	  JRST	DMPEND		;DIRECTORY DEVICE OR EOT
	CALL	FILEND		;OUTPUT END OF FILE MESSAGE
	CALL	INPCLS		;CLOSE INPUT FILE
IFN FT$WLD,<
	MOVE	T1,[XWD SVINOB,OPNBLK] ;RESET OPEN BLOCK
	BLT	T1,LKPBLK+.RBTIM;(COPY LKPBLK ALSO IN CASE CAN'T REOPEN)
	OPEN	INPC,OPNBLK	;GET THE DEVICE AGAIN
	 JRST	[IFE FT$SEG,<CALL UPSCN> ;CAN'T--GET HISEG IF NEEDED
		CALL	E.DFO##	;CAN'T--REPORT ERROR
		JRST	DMPE.1]	;AND GO FINISH UP
	CALL	OPNI.A		;SETUP BUFFERS , ETC.
>;END IFN FT$WLD
IFE FT$WLD,<
	CALL	OPNINP		;REOPEN INPUT FILE
>;END IFE FT$WLD
	SOJG	P1,DUMP$G	;JUMP IF MORE FILES
	JUMPG	P2,DUMP$G	;OR MORE RECORDS
	JRST	DMPE.1		;END OF DUMP

;HERE AT END OF DUMP

DMPEND:
	TLNE	F,FL$EOT	;GET HERE WITH END OF TAPE?
	 JRST	DMPE.1		;YES--DON'T OUTPUT END OF FILE MESSAGE
	HRROI	T1,FN$END	;GET END FUNCTION
	CAME	T1,(A)		;IS IT NEXT ON THE LIST
	 JRST	[CALL	O$CRLF	;NO--NEW LINE
		JRST	DMPE.1]	;AND SKIP
	CALL	FILEND		;YES--OUTPUT END MESSAGE
DMPE.1:	MOVEI	T1,ENDMS1	;FIRST PART OF MESSAGE
	CALL	O$STRG		;SEND IT
	MOVE	T1,TOTFIL	;GET # FILES DUMPED
	JUMPE	T1,DMPE.2	;JUMP IF NONE
	CALL	O$DECW		;SEND FILES
	MOVEI	T1,ENDMS2	;GET MESAGE
	CALL	O$STRG		;SEND IT
DMPE.2:	MOVE	T1,TOTREC	;AND RECORDS
	CALL	O$DECW		;OUTPUT THEM
	TLNN	DC,(DV.MTA)	;MTA INPUT?
	 TLNE	F,FL$FOR!FL$PHY	;NO--/FORTRA OR /IREAD?
	  SKIPA	T1,[EXP ENDMS3]	;MTA OR /FORTRA OR /IREAD
	  MOVEI	T1,ENDMS4	;MUST BE STRAIGHT DISK INPUT
	CALL	O$STRG		;SEND IT
	MOVEI	T1,ENDMS5	;FINAL MESSAGE
	CALL	O$STRG		;SEND IT
	CALL	FRCTYO		;IF TTY, FORCE OUTPUT OUT TO KEEP USER HAPPY
	HRROI	T1,FN$END	;GET END FUNCTION
	CAME	T1,0(A)		;IS IT COMING UP?
	 JRST	DMPLUP		;NO--BACK FOR MORE
	MOVEI	T1,ENDMSG	;YES--GET END MESSAGE
	CALL	O$STRG		;END THE WORLD
	PJRST	FRCTYO		;RETURN, FORCING OUTPUT IF TTY

ENDMS1:	ASCIZ$	<[DMPTOT TOTAL OF >
ENDMS2:	ASCIZ$	< FILES AND >
ENDMS3:	ASCIZ$	< RECORDS>
ENDMS4:	ASCIZ$	< BLOCKS>
ENDMS5:	ASCIZ$	< IN DUMP]
>
ENDMSG:	ASCIZ$	<[DMPERD END OF REQUESTED DUMP]
>
SUBTTL	OUTPUT INITIAL HEADER 

INIHDR:	CALL	.SAVE1##	;MIGHT AS WELL
	SKIPN	TITLEB		;WAS THERE A /TITLE?
	JRST	INIH.1		;NO
	MOVEI	T1,TITLEB	;YES--GET ADDRESS
	CALL	O$STRG		;SEND IT
	CALL	O$CRLF		;NEW LINE
INIH.1:	CALL	O$CRLF		;AND ANOTHER
	MOVEI	T1,IMES1	;FIRST PART OF MESSAGE
	CALL	O$STRG		;PLEASE EXCUSE THE COMMENTS
	MOVEI	T1,O$CHAR	;BUT THIS CODE IS VERY SELF-EXPLANATORY
	CALL	.TYOCH##	;SETUP MY OUTPUT ROUTINE WITH SCAN
	SAVE$	T1		;REMEMBER OLD WON
	CALL	TINSPC		;TYPE OUT THE INPUT FILE SPEC
	TLNN	DC,(DV.MTA)	;IS INPUT A MAGTAPE?
	 JRST	INIH.4		;NO
	SKIPN	REELID		;YES--WAS THERE A REELID ON THE TAPE?
	 JRST	INIH.3		;NO
	MOVEI	T1,IMES5	;GET THE MESSAGE
	CALL	O$STRG		;SEND IT
	MOVE	T1,REELID	;GET THE REELID
	CALL	O$SIXW		;SEND IT
INIH.3:	CALL	O$SPAC		;SPACE OVER
	MOVEI	P1,INPC		;GET CHANNEL

	MTCHR.	P1,		;GET CHARACTERISTICS
	 SETZ	P1,		;SNH
	TRNE	P1,MT.7TR	;IS IT SEVEN TRACK?
	 SKIPA	T1,[EXP "7"]	;YES--SETUP
	  MOVEI	T1,"9"		;NO--MUST BE 9
	CALL	O$CHAR		;SEND IT
	MOVEI	T1,IMES6	;GET "<SP>TRACK"
	CALL	O$STRG		;SEND IT
	LDB	T1,[POINT 3,P1,35] ;GET DENSITY
	MOVE	T1,DENTBL(T1)	;GET STRING ADDRESS
	CALL	O$STRG		;TELL DENSITY
	MOVEI	T1,BPIMES	;TELL WHAT WE JUST TOLD
	CALL	O$STRG		;TELL IT
INIH.4:	MOVEI	T1,IMES2
	CALL	O$STRG
	CALL	.TDATN##	;ADD THE DATE
	MOVEI	T1,IMES3
	CALL	O$STRG
	CALL	.TTIMN##	;AND THE TIME
	CALL	RBRKNL		;NEXT LINE
	MOVEI	T1,IMES4
	CALL	O$STRG
	CALL	CMDOUT		;DUMP THE COMMAND
	CALL	RBRKNL
	CALL	FRCTYO		;FORCE OUT TO TTY IF IT IS TTY
	RESTR$	T1
	PJRST	.TYOCH##	;GIVE SCAN BACK ITS OUTPUT RTN

IMES1:	ASCIZ$	<[DUMP OF >
IMES2:	ASCIZ$	< ON >
IMES3:	ASCIZ$	< AT >
IMES4:	ASCIZ$	<[DMPCMD COMMAND: >
IMES5:	ASCIZ$	< - REELID=>
IMES6:	ASCIZ$	< TRACK/>
BPIMES:	ASCIZ$	< BPI>
DENTBL:	[ASCIZ	/(DEFAULT)/]
	[ASCIZ	/200/]
	[ASCIZ	/556/]
	[ASCIZ	/800/]
	[ASCIZ	/1600/]
	[ASCIZ	/6250/]
	[ASCIZ	/(6)/]
	[ASCIZ	/(7)/]

RBRKNL:	PJSP	T1,O$STRG
	ASCIZ	.]
.

TINSPC:	MOVEI	T1,SVINOB	;POINT TO OPEN BLOCK
	MOVEI	T2,SVINLK	;AND LOOKUP BLOCK
	PJRST	.TOLEB##	;TYPE INPUT SPEC AND RETURN
SUBTTL	DUMP THE COMMAND TO THE DUMP FILE

CMDOUT:	MOVE	T2,[POINT 7,CMDBFR]	;INIT THE POINTER
	SETZ	T3,		;CLEAR THE HYPHEN FLAG (CONTINUED COMMANDS)
CMDO.1:	ILDB	T1,T2		;GET A CHARACTER
CMDO.3:	JUMPE	T1,$POPJ	;?? GOT TO END ??
	CAIE	T1,"-"		;IS THIS A HYPHEN/
	 JRST	CMDO.2		;NO--CHECK FURTHER
	MOVE	T1,T2		;YES--GET NEXT CHARACTER
	ILDB	T1,T1		;...
	CAIGE	T1," "		;.GE. A SPACE (ROUGH APPROX OF EOL)
				;THIS WOULD BE LIKE IN A DATE
	 SOJA	T3,CMDO.1	;PROBABLY EOL--FLAG AND GO
	MOVEI	T1,"-"		;PROBABLY NOT EOL--RESET HYPHEN
	JRST	CMDO.4		;AND GO SEND IT
CMDO.2:	CAIE	T1,.CHTAB	;IS IT A TAB?
	 CAIL	T1," "		;OR GE SPACE
	  JRST	CMDO.4		;YES--GO SEND TO DUMP
	JUMPE	T3,$POPJ	;IF WE HAVEN'T SEEN A "-" THEN THIS IS THE END
	SETZ	T3,		;CLEAR HYPHEN FLAG AT EOL
	CAIE	T1,.CHCRT	;IS IT A CARRIAGE RETURN?
	JRST	CMDO.1		;NO--MUST BE ALTMODE OR SOME SUCH EOL
	ILDB	T1,T2		;YES--GET (POSSIBLE LINEFEED)
	CAIN	T1,.CHLFD	;IS IT?
	JRST	CMDO.1		;YES--GET NEXT CHARACTER
	JRST	CMDO.3		;NO--GO PROCESS THIS ONE
CMDO.4:	CALL	O$CHAR		;OUTPUT CHARACTER
	JRST	CMDO.1		;DO MORE
SUBTTL	OUTPUT RECORD (BLOCK) HEADER

RECHDR:	AOS	RECORD		;COUNT THE RECORD
	AOS	TOTREC		;AND TOTAL RECORDS
	TLNE	F,FL$TOT	;TOTALS ONLY?
	 POPJ	P,		;YES--DONE
	MOVEI	T1,1		;RESET WRDCNT
	MOVE	T2,LINRDX	;GET /LINRDX: VALUE
	CAIE	T2,LRXDEC	;IS IT /LINRDX:DEC?
	 MOVEI	T1,0		;NO--WORDS START AT ZERO
	MOVEM	T1,WRDCNT	;SO LINE #'S WILL BE RIGHT(IF NOT /OMIT)
	TLNN	F,FL$SUM	;/SUMMARY?
	CALL	O$CRLF		;NEW LINE FOR NEW RECORD
	CALL	O$CRLF		;AND ANOTHER
RECH.1:	TLNN	DC,(DV.DIR)	;DIRECTORY DEVICE?
	 JRST	RECMTA		;NO--MTA
	MOVEI	T1,BLKMS1	;YES--GET MESSAGE
	TLNE	F,FL$FOR!FL$PHY	;/FORTRA OR /IREAD?
	 MOVEI	T1,BLKMS3	;YES--DIFFERENT MESSAGE
	CALL	O$STRG
	MOVE	T1,RECORD	;GET RECORD #
	CALL	O$DECW
	MOVEI	T1,":"
	CALL	O$CHAR
	HLRE	T1,W		;GET WORD COUNT
	MOVNS	T1		;MAKE POSITIVE
	CALL	O$DECW
	JRST	RECH.2		;REJOIN COD

BLKMS1:	ASCIZ$	<[BLOCK >
BLKMS2:	ASCIZ$	< WORDS>
BLKMS3:	ASCIZ$	<[RECORD >
RECMS1:	ASCIZ$	<[FILE >
RECMS2:	ASCIZ$	< RECORD >
RECMS3:	ASCIZ$	< CHARACTERS>
RECMTA:	MOVEI	T1,RECMS1
	CALL	O$STRG
	MOVE	T1,FILE		;FILE COUNT
	CALL	O$DECW
	MOVEI	T1,RECMS2
	CALL	O$STRG
	MOVE	T1,RECORD
	CALL	O$DECW
	MOVEI	T1,":"
	CALL	O$CHAR
	HLRE	T1,W		;WORD COUNT
	MOVNS	T1
	CALL	O$DECW
RECH.2:	MOVEI	T1,BLKMS2
	CALL	O$STRG		;SEND IT
	CAIE	M,MODASC	;/MODE:ASCII?
	 JRST	RECH.3		;NO
	CALL	O$SPAC		;SPACE ONE
	HLRE	T1,W		;YES--GET WORDS AGAIN
	MOVNS	T1
	IMULI	T1,5		;CVT TO CHARACTERS
	CALL	O$DECW		;OUTPUT IT
	MOVEI	T1,RECMS3	;MESSAGE
	CALL	O$STRG
RECH.3:	MOVEI	T1,"]"		;CLOSE INFO
	CALL	O$CHAR		;...
	TLNE	F,FL$OLY!FL$SUM	;ONLY IN EFFECT? (OR /SUMMARY)
	PJRST	FRCTYO		;YES--NEW LINE STUFF DONE LATER
	CAIE	M,MODEBC	;MODE EBCDIC?
	CAIN	M,MODASC	;MODE ASCII?
	 TLNN	F,FL$OMI	;ASCII OR EBCDIC--AND /OMIT?
	  JRST	D$NEWL		;NO--DO NEW LINE THING
	PJRST	O$CRLF		;YES--NEW LINE AND RETURN
;HERE TO DO WRDCNT AT BEGINNING OF LINE

D$NEWL:	CAIE	M,MODASC	;IF /MODE:ASCII
	 CAIN	M,MODEBC	;OR /MODE:EBCDIC
	TLNN	F,FL$OMI	;RIGHT--AND /OMIT?
	CALL	O$CRLF		;NO--NEW LINE
	TLNE	F,FL$OMI	;/OMIT?
	 JRST	D$NEW2		;YES--SKIP A LITTLE
	MOVE	T1,WRDCNT	;GET THE WORD COUNT
	MOVE	T3,LINRDX	;GET SPECIFIED LINE # RADIX
	MOVE	Q,LNOWID-1(T3)	;SETUP Q TO THE WIDTH
	MOVE	T4,LNORDX-1(T3)	;AND THE RADIX
	CALL	@LNODSP-1(T3)	;DO LINE NO IN SPECIFIED RADIX
	MOVEI	T1,"/"		;END THE LINE #
	CALL	O$CHAR		;(EACH FORMAT DOES A SPACE FIRST)
				;(SO WE DON'T NEED ONE AFTER THE SLASH)
D$NEW2:	CALL	D$MSET		;RESET L AND Q
	ADDM	L,WRDCNT	;UPDATE WRDCNT FOR NEXT LINE
	POPJ	P,

;TABLE OF LINE # (WORD COUNT) RADICES

LNORDX:	EXP	^D10		;
	EXP	^D16
	EXP	^D8

;WIDTHS OF LINE #S IN SPECIFIED RADIX

LNOWID:	EXP	^D6
	EXP	^D7
	EXP	^D8

LNODSP:	EXP	FMTINT		;INTEGER
	EXP	FMTR.1		;HEX
	EXP	FMTR.1		;OCTAL
SUBTTL	OUTPUT END OF FILE MESSAGE

FILEND:	
	TLNN	F,FL$TOT	;UNLESS /TOTAL
	CALL	O$CRLF		;NEED NEW LINE
	TLNN	DC,(DV.MTA)	;IS IT MAGTAPE?
	 TLNE	F,FL$FOR!FL$PHY	;DSK--FORTRAN OR PHYSICS?
	  SKIPA	T1,[FILMS1]	;MTA OR FORTRAN/IREAD
	MOVEI	T1,FILMS3	;JUST STRAIGHT DISK INPUT
	CALL	O$STRG
	MOVE	T1,RECORD	;RECORDS
	CALL	O$DECW		;...
	TLNN	DC,(DV.MTA)	;MTA INPUT?
	TLNE	F,FL$FOR!FL$PHY	;DSK--IS IT FORTRAN OR IREAD?
	 SKIPA	T1,[FILMS2]	;MTA OR RECORD-ORIENDTED DISK INPUT
	MOVEI	T1,FILMS4	;DISK BLOCK ORIENTED
	CALL	O$STRG
	MOVE	T1,FILE
	CALL	O$DECW
	MOVEI	T1,IMES2	;"<SP>ON<SP>"
	CALL	O$STRG
	MOVEI	T1,O$CHAR
	CALL	.TYOCH##
	SAVE$	T1
	CALL	TINSPC		;TYPE OUT THE INPUT FILE SPEC.
	RESTR$	T1
	CALL	.TYOCH##
	CALL	RBRKNL
	SETZM	RECORD		;MOVING ALONG
	TLNN	DC,(DV.MTA)	;ONLY MTA HAS MULTIPLE FILES
	 PJRST	FRCTYO		;SO DON'T MESS UP THE TOTALS NOW
	AOS	FILE
	AOS	TOTFIL
	PJRST	FRCTYO		;FORCE OUTPUT IF TTY OUTPUT

FILMS1:	ASCIZ$	<[DMPRIF >
FILMS2:	ASCIZ$	< RECORDS IN FILE >
FILMS3:	ASCIZ$	<[DMPBIF >
FILMS4:	ASCIZ$	< BLOCKS IN FILE >
SUBTTL	/MODE -- SETUP CHARS/WORD AND WORDS/LINE

D$MOD:	MOVE	M,P2		;SET M TO THE MODE
	CAIN	M,MODBYT	;IS THIS /MODE:BYTE?
	 JRST	D$MBYT		;YES--SET IT UP
	CAIN	M,MODHAL	;SEE IF /MODE:HALF
	 JRST	D$MHLF		;YES--SETUP
	CALL	D$MSET		;SETUP L AND Q
	JRST	DMPLUP		;CONTINUE

;HERE TO SET MODE--CALLED AT END OF LINE TO RESET L AND Q

D$MSET:	CAIN	M,MODBYT	;/MODE:BYTE?
	 JRST	MSETBY		;YES--DO IT
	CALL	GETWID		;GET THE WIDTH REQUIRED FOR THE DUMP
	TLNE	F,FL$IND	;/INDUSTRY?
	 SKIPA	Q,MODTBI(M)	;YES--GET RIGHT SIZE FOR THAT
	MOVE	Q,MODTBL(M)	;GET WIDTH OF ONE WORDS' WORTH
	TLNE	F,FL$RDX	;/RADIX IN EFFECT?
	 MOVE	Q,USRWID	;YES--GET COMPUTED WORD WIDTH
	IDIVI	T1,(Q)		;COMPUTE WORDS/LINE
	SKIPN	T2		;IF A ZERO REMAINDER
	 SUBI	T1,1		;MUST SUBTRACT ONE--80 CPL DOES A FREE CRLF
	HRRZ	L,T1		;PUT IN L FOR COUNTING
	POPJ	P,
MSETBY:	MOVE	L,BYTBPL	;GET BYTES/LINE
	MOVE	Q,BYTDPB	;AND DIGITS/BYTE
	POPJ	P,

GETWID:	TRNN	DC,(DV.TTY)	;IS DUMP TO THE TTY?
	 JRST	GETW.1		;NO--
	SKIPLE	T1,FLWIDT	;WAS /WIDTH GIVEN (OR IS THIS 1ST TIME?)
	 JRST	GETW.2		;GOT IT--GO AHEAD
	MOVE	T1,[XWD 2,T2]	;SETUP TO DO A TRMOP
	MOVEI	T2,.TOWID	;GET THE WIDTH FUNCTION
	PJOB	T3,		;FIND MY JOB #
	TRMNO.	T3,		;TO FIND TTY UDX
	 SKIPA			;CAN'T--JUST USE DEFAULT AD.WID
	TRMOP.	T1,		;READ TTY WIDTH SETTING
	 MOVEI	T1,AD.WID	;CAN'T FOR SOME REASON--USE A GOOD DEFAULT
	MOVEM	T1,FLWIDT	;SET FOR LATER USE
	JRST	GETW.2		;JUMP IN TO COMMON CODE
GETW.1:	SKIPG	T1,FLWIDT	;NOT TTY--WAS /WIDTH GIVEN/
	 MOVEI	T1,MX.WID	;NO--USE ^D132
GETW.2:	TLNE	F,FL$OMI	;OMITTING LINE NUMBERS?
	 POPJ	P,		;YES--DONE
	MOVE	T2,LINRDX	;NO--GET LINE RADIX
	SUB	T1,LNOWID-1(T2)	;UNCOUNT WHAT WE WILL EAT FOR WORD COUNT
	POPJ	P,		;RETURN

MODTBL:	EXP	^D13		;OCTAL
	EXP	^D6		;ASCII
	EXP	-1		;BYTYE
	EXP	^D5		;EBCDIC
	EXP	^D15		;FLOAT
	EXP	-1		;HALF
	EXP	^D10		;HEX
	EXP	^D14		;INTEGER
	EXP	^D13		;OCTAL
	EXP	^D7		;SIXBIT
	EXP	^D24		;SYMBOL

MODTBI:	EXP	^D12		;OCTAL
	EXP	^D5		;ASCII
	EXP	-1		;BYTE
	EXP	^D5		;EBCDIC
	EXP	^D15		;FLOATING POINT
	EXP	-1		;HALF
	EXP	^D9		;HEX
	EXP	^D12		;INTEGER
	EXP	^D12		;INTEGER
	EXP	-1		;SIXBIT
	EXP	-1		;SYMBOL
SUBTTL	/MODE -- SETUP FOR /MODE:BYTE

D$MBYT:	MOVSI	T2,(POINT)	;BEGIN TO FORM BYTE PTR
	HRRI	T2,P1		;WILL LOAD FROM P1
	DPB	P1,[POINT 6,T2,11] ;SET SIZE IN
	MOVEM	T2,BYTPTR	;SAVE FOR LATER
	TLNE	F,FL$IND	;/INDUSTRY?
	 SKIPA	T1,[EXP ^D32]	;YES
	  MOVEI	T1,^D36		;NO--FULL WORD
	IDIVI	T1,(P1)		;GET BYTES/WORD
	MOVEM	T1,BYTBPW	;...
	MOVEM	T2,BYTREM	;SAVE REMAINDER BYTES ALSO
	MOVE	T1,P1		;COPY SIZE
	CALL	GMBWID		;GET THE WIDTH FOR A BYTE
	MOVEM	T1,BYTDPB	;SAVE FOR LATER
	MOVE	T1,BYTBPW	;GET BYTES/WORD
	IMUL	T1,BYTDPB	;TIMES DIGITS/BYTE
	ADD	T1,BYTBPW	;+ SLASHES AND SPACE
	MOVEM	T1,BYTWID	;= WIDTH OF WORD OF BYTES
	SKIPN	T1,BYTREM	;WAS THERE A REMAINDER?
	 JRST	D$MBY1		;NO
	CALL	GMBWID		;GET WIDTH OF THAT
	 AOJ	T1,		;COUNT THE COMMA TOO
	ADDM	T1,BYTWID	;ADD INTO WIDTH
	MOVEM	T1,BYTRDB	;SAVE FOR LATER USE
D$MBY1:	CALL	GETWID		;GET THE WIDTH TO USE FOR OUTPUT
	IDIV	T1,BYTWID	;TO GET WORDS/LINE
	MOVEM	T1,BYTBPL	;SAVE BYTES/LINE
	MOVE	L,T1		;COPY 
	AOS	BYTDPB		;+1 SO FMTRDX WORKS
	JRST	DMPLUP		;CONTINUE

;HERE WITH T1=BYTE SIZE
;RETURN T1=DIGITS REQUIRED TO DISPLAY IT.  USES T2,T3

GMBWID:	MOVE	T3,USERDX	;GET /RADIX:N OR 8
	SETZ	T2,		;ZERO POWER OF TWO COUNT
	LSH	T3,-1		;DIVIDE BY TWO
	 SKIPE	T3		;DONE?
	  AOJA	T2,.-2		;NO--LOOP AROUND
	IDIVI	T1,(T2)		;YES--COMPUTE DIGITS REQUIRED
	JUMPE	T2,$POPJ	;JUMP IF ALL IS WELL
	 AOJA	T1,$POPJ	;NO--NEED ONE MORE DIGIT--SO DO IT

;HERE FOR /MODE:HALF SETUP

D$MHLF:	MOVEI	P1,^D18		;SETUP THE BYTE SIZE
	TLNE	F,FL$IND	;SEE IF /INDUSTRY
	 MOVEI	P1,^D16		;YES--DIFFERENT SIZE
	MOVEI	M,MODBYT	;SETUP M TO BYTE MODE
	JRST	D$MBYT		;DO BYTE SETUP
SUBTTL	DUMP FILE OUTPUT ROUTINES

;O$CRLF -- OUTPUT CRLF TO DUMP FILE

O$CRLF:	MOVEI	T1,.CHCRT	;CARRIAGE RETURN
	CALL	O$CHAR		;DUMP IT
	MOVEI	T1,.CHLFD	;LINED FEED
		;FALL INTO O$CHAR TO SEND LINEFEED

;O$CHAR -- OUTPUT CHARACTER IN T1 TO DUMP FILE

O$CHAR:	SOSG	OBHR+.BFCTR	;ROOM IN THE BUFFER?
	 JRST	O$BUFR		;NO--MAKE SOME
O$CHR1:	IDPB	T1,OBHR+.BFPTR	;STORE CHARACTER
	TLO	F,FL$ODN	;WE HAVE DONE SOME OUTPUT
	AOS	CHRKNT		;COUNT FOR PEOPLE WHO NEED IT
	POPJ	P,
O$BUFR:	CALL	.PSH4T##	;PRESERVE T1-4 (XCTIO USES T2 AT LEAST)
	CALL	XCTIO		;WRITE A BUFFER
	 OUT	OUTC,		;XCT'D
	  SKIPA			;?? DEVICE IS FULL OR EOT ??
	JRST	[PUSHJ	P,.POP4T## ;RESTORE REGS
		JRST	O$CHR1]	;AND CONTINUE
	ERROR.	EF$ERR,ODF,<OUTPUT DEVICE IS FULL>
	CALL	OUTCLS		;TRY TO PRESERVE WHAT WE CAN
	PJRST	ERRFTL		;GO DIE

;O$STRG -- OUTPUTS ASCIZ STRING POINTED TO BY T1 TO DUMP FILE

O$STRG:	HRLI	T1,(POINT 7)	;FORM PTR
	PUSH	P,T1		;SAVE ON PDL
O$STR1:	ILDB	T1,(P)		;GET CHAR
	JUMPE	T1,TPOPJ	;JUMP IS END OF STRING
	CALL	O$CHAR		;WRITE THE CHARACTER
	JRST	O$STR1		;LOOP
;O$SPEC -- OUTPUT SPACE IF NOT /OMIT
;O$SPAC -- OUTPUT A SPACE
;O$DOT  -- OUTPUT A DOT
;O$SLSH -- OUTPUT A SLASH
;O$TABC -- OUTPUT A TAB
;O$COMA -- OUTPUT A COMMA

O$SPEC:	TLNE	F,FL$OMI	;/OMIT?
	POPJ	P,		;YES
O$SPAC:	SKIPA	T1,[EXP " "]	;DO A SPACE
O$DOT:	MOVEI	T1,"."		;DO A DOT
	PJRST	O$CHAR
O$TABC:	SKIPA	T1,[EXP	"	"] ;GET A TAB
O$SLSH:	MOVEI	T1,"/"		;GET ONE
	PJRST	O$CHAR		;AND SEND IT
O$COMA:	MOVEI	T1,","		;GET A COMMA
	PJRST	O$CHAR		;SEND IT

;O$HEXW --OUTPUT 36 BIT HEX WORD
;O$HEXI -- OUTPUT 32 BIT HEX WORD (INDUSTRY)

O$HEXI:	SKIPA	T3,[DEC 8]	;8 HEX CHARS
O$HEXW:	MOVEI	T3,^D9		;9 HEX CHARS
	MOVE	T2,T1		;POSITION NUMBER
	CALL	O$SPAC		;SPACE OVER A CHARACTER
O$HEX1:	SETZ	T1,		;CLEAR RESULT
	LSHC	T1,4		;GET A HEX DIGIT
	CALL	O$DIGT		;OUTPUT IT
	SOJG	T3,O$HEX1	;DO 8 OR 9
	POPJ	P,
SUBTTL	SYMBOLIC OUTPUT

;HERE TO OUTPUT WORD IN T1 IN SYMBOLIC FORMAT

O$SYMW:
IFE FT$ISD,<
	ERROR.	EF$FTL,SNI,<SYMBOLIC DUMP NOT IMPLEMENTED>
>;END IFE FT$ISD
IFN FT$ISD,<
	CALL	.SAVE1##	;SAVE P1
	MOVE	P1,T1		;COPY WORD
	CALL	O$SPAC		;SPACE OVER
	SETZM	CHRKNT		;CLEAR COUNTER
	LDB	T1,[POINT 9,P1,8];GET OP CODE
	CAIL	T1,700		;SEE IF DIRECT I/O INSTR
	 JRST	DIOIOW		;YES--GO DO IT
	CAIGE	T1,40		;SEE IF LUUO
	 JRST	UUOIOW		;YES--GO DO THAT
	MOVE	T1,MNETBL-40(T1);NO--GET OPCODE
	CALL	O$SIXW		;SHOW IT
OSYM.2:	CALL	O$SPAC		;GET A SPACE
	CALL	O$SPAC		;AND ONE MORE
	LDB	T1,[POINT 4,P1,12] ;GET AC FIELD
OSYM2A:	JUMPE	T1,OSYM.4	;JUMP IF 0
	CALL	O$OCTW		;SHOW IT
	CALL	O$COMA		;AND A COMMA
OSYM.4:	MOVEI	T1,"@"		;IN CASE INDIRECTION NEEDED
	TLNE	P1,(1B13)	;CHECK IF SO
	CALL	O$CHAR		;SEND THE INDIRECT BIT
	HRRZ	T1,P1		;GET RH 18 BITS
	CALL	O$OCTW		;SEND IT
	LDB	T1,[POINT 4,P1,17] ;SEE IF INDEX FIELD
	JUMPE	T1,OSYM.6	;JUMP IF NO INDEX
	PUSH	P,T1		;SAVE INDEX
	MOVEI	T1,"("		;START INDEX FIELD
	CALL	O$CHAR		;SEND IT
	POP	P,T1		;GET INDEX FIELD
	CALL	O$OCTW		;SEND IT
	MOVEI	T1,")"		;CLOSE INDEX
	CALL	O$CHAR		;SEND IT
OSYM.6:	MOVE	T1,CHRKNT	;GET COUNT TO HERE
	SUBI	T1,^D23		;THIS MANY CHARS IN FULL INSTR
	JUMPGE	T1,$POPJ	;JUMP IF NO PADDING NEEDED
	PUSH	P,T1		;NO--SAVE AMT NEEDED
	CALL	O$SPAC		;SEND ONE
	AOSGE	(P)		;SEE IF DONE
	 JRST	.-2		;NO--DO MORE
	JRST	TPOPJ		;CLEAR PDL AND RETURN

;HERE IF UUO IS 0-40

UUOIOW:	JUMPE	T1,UUO000	;JUMP IF ILL UUO
	MOVEI	T1,[ASCIZ/UUO/]
	CALL	O$STRG		;SEND UUO
	LDB	T2,[POINT 9,P1,8] ;GET OP CODE
	MOVSS	T2		;MOVE TO LH
	LSH	T2,^D9		;PUT TO HIGH 9 BITS
	MOVEI	T3,3		;TYPE 3 OCTAL DIGITS
	CALL	FMTO.1		;TYPE THEM
	JRST	OSYM.2		;CONTINUE

UUO000:	MOVSI	T1,'Z  '	;GET A SIXBIT "Z"
	CALL	O$SIXW		;SEND SIXBIT (WILL SEND NULLS AS BLANKS)
	PJRST	OSYM.2		;CONTINUE

;HERE FOR DIRECT I/O INSTRS

DIOIOW:	LDB	T1,[POINT 3,P1,12] ;GET 3 BITS THAT TELL THE TALE
	MOVE	T1,IOINTB(T1)	;GET THE SIXBIT FOR IT
	CALL	O$SIXW		;TYPE IT OUT
	CALL	O$SPAC		;AND THEN TWO SPACES
	CALL	O$SPAC		;...
	LDB	T1,[POINT 7,P1,9] ;GET DEVICE CODE
	JRST	OSYM2A		;GO JUMP INTO THE PROCESSING

SYMXWD:	HLRZ	T1,P1		;GET LH
	CALL	O$OCTW		;SHOW LH
	MOVEI	T1,[ASCIZ/,,/]	;SOME COMMAS
	CALL	O$STRG
	HRRZ	T1,P1		;GET RH
	CALL	O$OCTW		;SHOW RH
	JRST	OSYM.6		;GO FINISH UP

IOINTB:	SIXBIT	/BLKI/
	SIXBIT	/DATAI/
	SIXBIT	/BLKO/
	SIXBIT	/DATAO/
	SIXBIT	/CONO/
	SIXBIT	/CONI/
	SIXBIT	/CONSZ/
	SIXBIT	/CONSO/

;SIXBIT TABLE OF INSTR MNENOMICS

DEFINE X(A)<IRP A,<SIXBIT/A/>>

MNETBL:
X (<CALL  ,INIT  ,UUO042,UUO043,UUO044,UUO045,UUO046,CALLI ,OPEN  ,TTCALL>)
X (<UUO052,UUO053,UUO054,RENAME,IN    ,OUT   ,SETSTS,STATO ,GETSTS,STATZ >)
X (<INBUF ,OUTBUF,INPUT ,OUTPUT,CLOSE ,RELEAS,MTAPE ,UGETF ,USETI ,USETO >)
X (<LOOKUP,ENTER ,UJEN  ,UUO101,UUO102,UUO103,UUO104,UUO105,UUO106,UUO107>)
X (<DFAD  ,DFSB  ,DFMP  ,DFDV  ,UUO114,UUO115,UUO116,UUO117,DMOVE ,DMOVN >)
X (<FIX   ,UUO123,DMOVEM,DMOVNM,FIXR  ,FLTR  ,UFA   ,DFN   ,FSC   ,IBP   >)
X (<ILDB  ,LDB   ,IDPB  ,DPB   ,FAD   ,FADL  ,FADM  ,FADB  ,FADR  ,FADRI ,FADRM >)
X (<FADRB ,FSB   ,FSBL  ,FSBM  ,FSBB  ,FSBR  ,FSBRI ,FSBRM ,FSBRB ,FMP   >)
X (<FMPL  ,FMPM  ,FMPB  ,FMPR  ,FMPRI ,FMPRM ,FMPRB ,FDV   ,FDVL  ,FDVM  >)
X (<FDVB  ,FDVR  ,FDVRI ,FDVRM ,FDVRB ,MOVE  ,MOVEI ,MOVEM ,MOVES ,MOVS  >)
X (<MOVSI ,MOVSM ,MOVSS ,MOVN  ,MOVNI ,MOVNM ,MOVNS ,MOVM  ,MOVMI ,MOVMM >)
X (<MOVMS ,IMUL  ,IMULI ,IMULM ,IMULB ,MUL   ,MULI  ,MULM  ,MULB  ,IDIV  >)
X (<IDIVI ,IDIVM ,IDIVB ,DIV   ,DIVI  ,DIVM  ,DIVB  ,ASH   ,ROT   ,LSH   >)
X (<JFFO  ,ASHC  ,ROTC  ,LSHC  ,UUO247,EXCH  ,BLT   ,AOBJP ,AOBJN ,JRST  >)
X (<JFCL  ,XCT   ,MAP   ,PUSHJ ,PUSH  ,POP   ,POPJ  ,JSR   ,JSP   ,JSA   >)
X (<JRA   ,ADD   ,ADDI  ,ADDM  ,ADDB  ,SUB   ,SUBI  ,SUBM  ,SUBB  ,CAI   >)
X (<CAIL  ,CAIE  ,CAILE ,CAIA  ,CAIGE ,CAIN  ,CAIG  ,CAM   ,CAML  ,CAME  >)
X (<CAMLE ,CAMA  ,CAMGE ,CAMN  ,CAMG  ,JUMP  ,JUMPL ,JUMPE ,JUMPLE,JUMPA >)
X (<JUMPGE,JUMPN ,JUMPG ,SKIP  ,SKIPL ,SKIPE ,SKIPLE,SKIPA ,SKIPGE,SKIPN >)
X (<SKIPG ,AOJ   ,AOJL  ,AOJE  ,AOJLE ,AOJA  ,AOJGE ,AOJN  ,AOJG  ,AOS   >)
X (<AOSL  ,AOSE  ,AOSLE ,AOSA  ,AOSGE ,AOSN  ,AOSG  ,SOJ   ,SOJL  ,SOJE  >)
X (<SOJLE ,SOJA  ,SOJGE ,SOJN  ,SOJG  ,SOS   ,SOSL  ,SOSE  ,SOSLE ,SOSA  >)
X (<SOSGE ,SOSN  ,SOSG  ,SETZ  ,SETZI ,SETZM ,SETZB ,AND   ,ANDI  ,ANDM  >)
X (<ANDB  ,ANDCA ,ANDCAI,ANDCAM,ANDCAB,SETM  ,SETMI ,SETMM ,SETMB ,ANDCM >)
X (<ANDCMI,ANDCMM,ANDCMB,SETA  ,SETAI ,SETAM ,SETAB ,XOR   ,XORI  ,XORM  >)
X (<XORB  ,IOR   ,IORI  ,IORM  ,IORB  ,ANDCB ,ANDCBI,ANDCBM,ANDCBB,EQV   >)
X (<EQVI  ,EQVM  ,EQVB  ,SETCA ,SETCAI,SETCAM,SETCAB,ORCA  ,ORCAI ,ORCAM >)
X (<ORCAB ,SETCM ,SETCMI,SETCMM,SETCMB,ORCM  ,ORCMI ,ORCMM ,ORCMB ,ORCB  >)
X (<ORCBI ,ORCBM ,ORCBB ,SETO  ,SETOI ,SETOM ,SETOB ,HLL   ,HLLI  ,HLLM  >)
X (<HLLS  ,HRL   ,HRLI  ,HRLM  ,HRLS  ,HLLZ  ,HLLZI ,HLLZM ,HLLZS ,HRLZ  >)
X (<HRLZI ,HRLZM ,HRLZS ,HLLO  ,HLLOI ,HLLOM ,HLLOS ,HRLO  ,HRLOI ,HRLOM >)
X (<HRLOS ,HLLE  ,HLLEI ,HLLEM ,HLLES ,HRLE  ,HRLEI ,HRLEM ,HRLES ,HRR   >)
X (<HRRI  ,HRRM  ,HRRS  ,HLR   ,HLRI  ,HLRM  ,HLRS  ,HRRZ  ,HRRZI ,HRRZM >)
X (<HRRZS ,HLRZ  ,HLRZI ,HLRZM ,HLRZS ,HRRO  ,HRROI ,HRROM ,HRROS ,HLRO  >)
X (<HLROI ,HLROM ,HLROS ,HRRE  ,HRREI ,HRREM ,HRRES ,HLRE  ,HLREI ,HLREM >)
X (<HLRES ,TRN   ,TLN   ,TRNE  ,TLNE  ,TRNA  ,TLNA  ,TRNN  ,TLNN  ,TDN   >)
X (<TSN   ,TDNE  ,TSNE  ,TDNA  ,TSNA  ,TDNN  ,TSNN  ,TRZ   ,TLZ   ,TRZE  >)
X (<TLZE  ,TRZA  ,TLZA  ,TRZN  ,TLZN  ,TDZ   ,TSZ   ,TDZE  ,TSZE  ,TDZA  >)
X (<TSZA  ,TDZN  ,TSZN  ,TRC   ,TLC   ,TRCE  ,TLCE  ,TRCA  ,TLCA  ,TRCN  >)
X (<TLCN  ,TDC   ,TSC   ,TDCE  ,TSCE  ,TDCA  ,TSCA  ,TDCN  ,TSCN  ,TRO   >)
X (<TLO   ,TROE  ,TLOE  ,TROA  ,TLOA  ,TRON  ,TLON  ,TDO   ,TSO   ,TDOE  >)
X (<TSOE  ,TDOA  ,TSOA  ,TDON  ,TSON  >)
>;END IFN FT$ISD
;O$SIXN -- OUTPUT SIXBIT WORD IN T1 TO DUMP FILE
;O$SIXW -- DITTO EXCEPT NO SPACE BEFORE WORD

O$SIXW:	MOVE	T2,T1		;POSITION
	JRST	O$SIX0		;SKIP THE SPACE
O$SIXN:	MOVE	T2,T1		;POSITION
	CALL	O$SPAC		;SPACE ONE
O$SIX0:	MOVEI	T3,6		;LOOP COUNT
O$SIX1:	SETZ	T1,		;CLEAR
	ROTC	T1,6		;PEEL OFF A CHARACTER
	ADDI	T1," "		;ASCIIIZE IT
	CALL	O$CHAR		;DUMP IT
	SOJG	T3,O$SIX1	;DO ALL
	POPJ	P,

;O$DECW -- OUTPUT DECIMAL WORD IN T1 TO DUMP FILE
;O$OCTW -- OUTPUT OCTAL WORD IN T1 TO DUMP FILE
;O$RDXW -- OUTPUT WORD IN T1 TO DUMP FILE IN RADIX IN T3
;***THESE ARE UNFORMATTED DUMP ROUTINES

O$OCTW:	SKIPA	T3,[^D8]	;OCTAL
O$DECW:	MOVEI	T3,^D10		;DECIMAL
O$RDXW:	JUMPGE	T1,ORDXW1	;JUMP IF POSITIVE
	MOVE	T2,T1		;NO--SAVE NUMBER
	MOVEI	T1,"-"
	CALL	O$CHAR
	MOVE	T1,T2
ORDXW1:	IDIV	T1,T3		;DIVIDE BY RADIX
	MOVMS	T2		;GT MAGNITUDE
	HRLM	T2,(P)		;SAVE ON PIDDLE LIST
	SKIPE	T1		;CHECK DONENESS
	CALL	ORDXW1		;RECURSE
	HLRZ	T1,(P)		;GET DIGIT
O$DIGT:	ADDI	T1,"0"		;ASCIIIZE IT
	CAILE	T1,"9"		;SEE IF OVERFLOW INTO ALPHAS
	ADDI	T1,"A"-"9"-1	;YES--PUT IT THERE
	PJRST	O$CHAR		;RECURSE OR RETURN
;O$ASCW -- DUMP WORD IN T1 IN ASCII

O$ASCW:	MOVE	T2,T1		;POSITION
	CALL	O$SPEC		;SPACE IF NOT /OMIT
	MOVEI	T3,5		;5 CHARS/WORD
O$ASC1:	SETZ	T1,		;CLEAR
	ROTC	T1,7		;GRAB A CHARACTER
	CALL	O$ASCC		;DUMP THE CHARACTER
	SOJG	T3,O$ASC1	;DO ALL 5
	POPJ	P,		;DONE

O$ASCC:	CAIL	T1,.CHTAB	;BETWEEN TAB AND CR?
	 CAILE	T1,.CHCRT	;...
	 CAIN	T1,.CHBEL	;IS IT A BELL?
	PJRST	O$CHAR		;TAB/LF/VT/FF/CR/BELL--GO PRINT IT
	TLNE	F,FL$OMI	;/OMIT?
	 JRST	O$ASC5		;YES--HANDLE SLIGHTLY DIFFERENT
	CAIL	T1," "		;LT A SPACE?
	CAILE	T1,"Z"+40	;AND LE A LOWER CASE Z?
O$AQST:	MOVEI	T1,"?"		;NO--MAKE IT A QUESTION MARK
O$ASC4:	PJRST	O$CHAR		;OUTPUT IT AND RETURN

;HERE TO SEE IF CONTROL CHARACTER (1-37, EXCEPT A FEW SPECIAL ONES)

O$ASC5:	CAIL	T1," "		;MAKE A GROSS CHECK
	 PJRST	O$CHAR		;TO ELIMINATE A LARGE PART OF THE ASCII SET
	SAVE$	T1		;ITS A REAL CONTROL CHARACTER--SAVE IT
	MOVEI	T1,"^"		;GET AN ARROW
	CALL	O$CHAR		;ZIP IT OUT
	RESTR$	T1		;GET CHARACTER BACK
	MOVEI	T1,100(T1)	;BY MAJIK IT BECOMES VISIBLE
	PJRST	O$CHAR		;GO PRINT IT

;O$IASC -- OUTPUT WORD IN T1 AS EIGHT-BIT ASCII

O$IASC:	MOVE	T2,T1		;SEE COMMENTS FOR O$ASCW
	CALL	O$SPEC
	MOVEI	T3,4		;ONLY 4 CHARS WORD
O$IAS1:	SETZ	T1,
	ROTC	T1,^D8
	ANDI	T1,177		;TRIM TO SEVEN BITS
	CALL	O$ASCC		;OUTPUT THE CHARACTER
	SOJG	T3,O$IAS1
	POPJ	P,
;O$BYTW -- OUTPUT WORD IN BYTE FORMAT

O$BYTW:	CALL	.SAVE3##	;GET A FEW
	MOVE	P1,T1		;POSITION WORD
	MOVE	P2,BYTPTR	;PTR TO LOAD BYTES
	MOVE	P3,BYTBPW	;GET # BYTES / WORD
	CALL	O$SPAC		;SPACE OUT
O$BYT1:	ILDB	T1,P2		;GET A BYTE
	CALL	FMTRDX		;OUTPUT IT
	SOJLE	P3,O$BYT2	;DONE?
	CALL	O$SLSH		;NO--SLASH ONE
	JRST	O$BYT1		;DO ANOTHER
O$BYT2:	SKIPN	T2,BYTREM	;WAS THERE A REMAINDER?
	POPJ	P,		;NO--DONE
	CALL	O$SLSH		;DO SLASH
	DPB	T2,[POINT 6,P2,11] ;SET IN THE SIZE
	ILDB	T1,P2		;GET THE BYTE
	MOVE	Q,BYTRDB	;GET WIDTH OF REMAINDER
	CALL	FMTRDX		;OUTPUT #
	MOVE	Q,BYTDPB	;RESET Q
	POPJ	P,
SUBTTL PRINT EBCDIC WORD

;O$EBCW -- OUTPUT EBCDIC WORD IN T1

O$EBCW:	MOVE	T2,T1		;COPY WORD
	CALL	O$SPEC		;SPACE IF NEEDED
	MOVEI	T3,4		;4 CPW
O$EBC1:	SETZ	T1,		;CLEAR RESULT
	ROTC	T1,^D8		;PEEL OFF A CHAR
	JUMPE	T1,O$EBC3	;IGNORE NULL CHARACTERS
	CALL	XLTEBC		;XLATE TO ASCII
	CALL	O$CHAR		;SEND IT
	SOSLE	EBCKNT		;HAVE WE DONE A LINE?
	 JRST	O$EBC3		;NO--SEE IF DONE WITH WORD
	MOVE	T1,S.BLKF	;RESET BLOCK FACTOR
	MOVEM	T1,EBCKNT	;...
	CALL	O$CRLF		;NEW LINE PLEASE
O$EBC3:	SOJG	T3,O$EBC1	;JUMP IF MORE CHARS THIS WORD
	POPJ	P,

XLTEBC:	CAIL	T1,.CHVTB	;LT A VERT TAB?
	 JRST	XLTE.1		;NO
	CAIN	T1,5		;IS IT A 5 (HORIZ. TAB)?
	 SKIPA	T1,[EXP .CHTAB]	;YES--MAKE IT ONE
XLTQST:	MOVEI	T1,"?"		;FLAG WE DON'T KNOW IT
	POPJ	P,
XLTE.1:	CAIG	T1,.CHCRT	;GT A CR?
	POPJ	P,		;VERT TAB TO CR
	CAIL	T1,^D129	;LT LOWER CASE A?
	 JRST	XLTE.4		;NO--HANDLE ALPHA NUMERICS
	PUSH	P,T1		;YES--SAVE CHARACTER
	MOVSI	T4,-N$ECHR	;SET LOOP
XLTE.2:	HLRZ	T1,EBCTAB(T4)	;GET EBCDIC FROM TABLE
	CAME	T1,(P)		;THIS IT?
	AOBJN	T4,XLTE.2	;NO--LOOP TO END OR FIND ONE
	POP	P,T1		;CLEAR STACK
	JUMPGE	T4,XLTQST	;JUMP IF WE DON'T KNOW IT
	HRRZ	T1,EBCTAB(T4)	;YES--GET ASCII EQUIVALENT
	POPJ	P,

XLTE.4:	PUSH	P,T1		;SAVE CHARACTER ON PDL
	MOVSI	T4,-N$ECH2	;GET A LOOPER
XLTE.5:	HLRZ	T1,EBCTB1(T4)	;GET LOWER LIMIT
	CAMLE	T1,(P)		;IN RANGE?
	 JRST	XLTE.6		;NO
	HRRZ	T1,EBCTB1(T4)	;HIGH LIMIT
	CAMGE	T1,(P)		;IN RANGE?
XLTE.6:	AOBJN	T4,XLTE.5	;NO--LOOP
	POP	P,T1		;GET CHARACTER BACK
	JUMPGE	T4,XLTQST	;NOT IN A GOOD RANGE
	ADD	T1,EBCTB2(T4)	;CONVERT TO ASCII
	POPJ	P,
EBCTAB:	XWD	^D5,.CHTAB	;5 BECOMES A TAB
	XWD	^D64," "
	XWD	^D74,"]"
	XWD	^D75,"."
	XWD	^D76,"<"
	XWD	^D77,"("
	XWD	^D78,"+"
	XWD	^D79,"^"
	XWD	^D80,"&"
	XWD	^D90,"!"
	XWD	^D91,"$"
	XWD	^D92,"*"
	XWD	^D93,")"
	XWD	^D94,";"
	XWD	^D95,"["
	XWD	^D96,"-"
	XWD	^D97,"/"
	XWD	^D107,","
	XWD	^D108,"%"
	XWD	^D109,"_"
	XWD	^D110,">"
	XWD	^D111,"?"
	XWD	^D122,":"
	XWD	^D123,"#"
	XWD	^D124,"@"
	XWD	^D125,"'"
	XWD	^D126,"="
	XWD	^D127,""""
	XWD	^D192,"?"
	XWD	^D208,":"
	XWD	^D255,"_"
N$ECHR==.-EBCTAB

EBCTB1:	XWD	^D129,^D137	;RANGES FOR ALPHA NUMERICS
	XWD	^D145,^D153
	XWD	^D162,^D169
	XWD	^D193,^D201
	XWD	^D209,^D217
	XWD	^D226,^D233
	XWD	^D240,^D249
N$ECH2==.-EBCTB1

EBCTB2:	EXP	-^D129+"A"-40	;LOWER CASE
	EXP	-^D145+"J"-40
	EXP	-^D162+"S"-40
	EXP	-^D193+"A"
	EXP	-^D209+"J"
	EXP	-^D226+"S"
	EXP	-^D240+"0"
SUBTTL	FORMATTED INTEGER I/O

FMTINT:	CALL	.SAVE2##	;PRESERVE P1-2
	MOVEI	P1,-1(Q)	;CHARACTERS/WORD (-1 SO WE DON'T COUNT SPACE)
	SETZ	P2,		;CLEAR COUNT OF WHAT WE SEND
	MOVE	T3,T1		;COPY NUMBER
	SKIPGE	T3		;CHECK NEGATIVE
	 TLOA	F,FL$NEG	;YES--SET FLAG
	  TLZA	F,FL$NEG	;NO--CLEAR IT
	MOVNS	T3		;IT WAS NEGATIVE--MAKE IT POSITIVE
FMTI.1:	IDIVI	T3,^D10		;GET A DIGIT
	ADDI	T4,"0"		;MAKES IT ASCII
	PUSH	P,T4		;SAVE ON PDL
	AOJ	P2,		;COUNT THE CHARACTER
	JUMPN	T3,FMTI.1	;JUMP IF MORE
	SUB	P1,P2		;GET THE DIFFERENCE
	MOVEI	T1," "		;SET IN CASE WE NEED TO PAD
	SOJE	P1,FMTSGN	;JUMP IF WE FIT OK
	CALL	O$CHAR
	SOJG	P1,.-1		;PAD THEM ALL
FMTSGN:	TLZE	F,FL$NEG	;SEE IF NEGATIVE?
	MOVEI	T1,"-"		;YES--GET ONE (ELSE USE THE SPACE)
	CALL	O$CHAR		;SEND SPACE OR MINUS SIGN
	JUMPLE	P2,$POPJ	;JUMP IF WE SENT NO DIGITS?
	POP	P,T1		;GET ONE BACK
	CALL	O$CHAR		;SEND IT
	SOJG	P2,.-2		;DO ALL WE LEFT ON PDL
	POPJ	P,		;DONE

;HERE TO DO (PROBABLY) OCTAL DUMP
;UNLESS /RADIX WAS SEEN THEN USE FMTRDX

FMTOCT:	TLNE	F,FL$RDX	;SEEN /RADIX?
	 JRST	FMTRDX		;YES--DO IT THE SLOW WAY
	MOVEI	T3,^D12		;NO--12 OCTAL DIGITS COMING UP
	MOVE	T2,T1		;WORD TO T2
	CALL	O$SPAC		;SPACE OVER ONE
FMTO.1:	SETZ	T1,		;CLEAR RESULT
	LSHC	T1,3		;PEEL OFF A DIGIT
	CALL	O$DIGT		;OUTPUT IT
	SOJG	T3,FMTO.1	;DO 12
	POPJ	P,
SUBTTL RADIX FORMATTED OUTPUT

;FMTRDX -- DUMP NUMBER IN T1 IN CURRENT RADIX (UNSIGNED)
;FMTR.1 -- DUMP NUMBER IN T1 IN RADIX IN T4
;THANKS TO ROGER UPHOFF FOR IDEA FROM DUMPER

FMTRDX:	MOVE	T4,USERDX	;CURRENT RADIX
FMTR.1:	CALL	.SAVE2##	;THESE MUST BE SACRED
	MOVEI	P1,-1(Q)	;COPY Q
	MOVEI	P2,-1(Q)	;A COUPLE OF TIMES
RDXLUP:	JUMPL	T1,RDXADJ	;SPECIAL IF NEGATIVE
	JUMPE	T1,RADXZR	;WATCH FOR END
	IDIV	T1,T4		;PEEL OFF A DIGIT
RDXCON:	ADDI	T2,"0"		;MAKE IT ASCII
	CAILE	T2,"9"		;IS IT A DIGIT?
	ADDI	T2,"A"-"9"-1	;NO--MOVE UP TO ALPHABETICS
	PUSH	P,T2		;SAVE ON PDL
	SOJG	P1,RDXLUP	;GO FOR MORE

RADXZR:	SUB	P2,P1		;GET # OF GOOD DIGITS
	MOVEI	T1," "		;SPACE OVER ONE
	CAIE	M,MODBYT	;UNLESS /MODE:BYTE
	CALL	O$CHAR
	JUMPLE	P1,RDXNZR	;DO WE NEED ANY LEADING ZEROES?
	MOVEI	T1,"0"		;YES--GET ONE
	CALL	O$CHAR		;SEND IT
	SOJG	P1,.-1		;DO ALL NEEDED
RDXNZR:	JUMPE	P2,$POPJ	;JUMP IF NO CHARS ON PDL (# WAS 0)
	POP	P,T1		;GET CHAR OFF PDL
	CALL	O$CHAR		;SEND IT
	SOJG	P2,.-2
	POPJ	P,

;HERE IF NUMBER IS NEGATIVE

RDXADJ:	TLZ	F,FL$TMP	;CLEAR TEMP FLAG
	LSHC	T1,-1		;DIVIDE BY TWO
	TLNE	T2,(1B0)	;WAS LOW ORDER BIT ON?
	TLO	F,FL$TMP	;YES--REMEMBER THAT
	IDIV	T1,T4		;DIVIDE BY RADIX
	LSH	T1,1		;MULTIPLY QUOTIENT BY 2
	LSH	T2,1		;SAME FOR REMAINDER
	TLZE	F,FL$TMP	;DID WE SHIFT OUT A ONE?
	 AOJ	T2,		;INCRMEMENT REMAINDER BY ONE
	IDIV	T2,T4		;DIVIDE REMAINDER BY RADIX
	SKIPE	T2		;IS THERE A QUOTIENT AGAIN?
	 AOJ	T1,		;YES--ADJUST ORIGINAL QUOTIENT
	MOVE	T2,T3		;POSITION REMAINDER
	JRST	RDXCON		;AND CONTINUE
SUBTTL	FORMATTED FLOATING POINT OUTPUT

;THANKS TO ROGER UPHOFF FOR ALGORITHM FROM DUMPER

FMTFLO:	CALL	SAVACS		;SAVE ACS
	TLZ	F,FL$TMP!FL$NEG!FL$FL2 ;CLEAR FLAGS
	SETZB	T4,T2		;CLEAR EXPONENT
	JUMPGE	T1,EFMT1	;NUMBER NEGATIVE?
	MOVN	T1,T1		;YES,NEGATE IT
	TLOA	F,FL$NEG	;SET NEGATIVE FLAG

EFMT1:	JUMPE	T1,EFMT7	;ESCAPE IF ZERO
	HLRZ	E1,T1		;EXTRACT EXPONENT
	LSH	E1,-9		;
	TLZ	T1,777000	; GET RID OF EXPONENT
	ASH	T1,^D8		;PUT BIN POINT BETWEEN BITS 0 AND 1

EFMT2:	HRREI	E2,-200+2(E1)	;GET RID OF EXCESS 200
	IMULI	E2,232		;DEC EXP=LOG10(2)*BIN EXP=.232(OCTAL)*BIN EXP
	ASH	E2,-^D9		;GET RID OF 3 OCTAL FRACTION DIGITS
	MOVM	E3,E2		;GET MAGNITUDE OF 10 SCALAR
	CAIGE	E3,PTLEN	;IS THE POWER OF 10 TABLE LARGE ENOUGH
	JRST	EFMT3		;YES
	JUMPL	E2,.+2		;NO, SCALE F BY LARGEST ENTRY
	SKIPA	E2,[PTLEN]	;GET ADDRESS OF LARGST POSITIVE POWER
	MOVNI	E2,PTLEN	;GET ADDR OF LARGEST NEGATIVE POWER
	CALL	BINEXP		;GET CORRESPONDING BINARY POWER OF TWO
	CALL	FLODIV		;SCALE BY A LARGE POWER OF TEN
	JRST	EFMT2		;DO SECOND SCALING

BINEXP:	MOVE	E3,E2		;COPY DECIMAL POWER
	LSHC	E3,-2		;DIVIDE BY 4-- EXP10 HAS 4 ENTRIES/WORD
	TLNE	E4,(1B0)	;WHICH HALF WORD?
	SKIPA	E3,EXP10(E3)	;RIGHT HALF
	HLRZ	E3,EXP10(E3)	;LEFT HALF
	TLNN	E4,(1B1)	;WHICH QUADRANT?
	LSH	E3,-^D9		;1ST OR 3RD
	ANDI	E3,777		 ;MASK TO SIZE
	POPJ	P,		;DONE
;SCALE SINGLE FRACTION BY A POWER OF TEN

FLODIV:	JUMPE	E2,$POPJ	;IF EXP IS ZERO RETURN
	ADD	T4,E2		;PUT SCALE FACTOR IN T4
	SUBI	E1,-200-1(E3)	;SUB BIN POWER OF 10 EXP FROM BIN
				; FRACTION EXP,REMOVE EXCESS 200;
				; -1 ALLOWS FOR ASHC,LH OF E1 IS GARBGE
	MOVEI	T2,0		;CLEAR LOW WORD
	CAMGE	T1,HITEN(E2)	;WILL DIVIDE CAUSE A DIVIDE CHECK?
	SOJA	E1,.+2		;NO, ALLOW FOR NOT DOING ASHC
	ASHC	T1,-1		;YES, SCALE FRACTION
	DIV	T1,HITEN(E2)	;SCALE BY A POWER OF TEN
	POPJ	P,		;RETURN

EFMT3:	CALL	BINEXP		; GET BIN EXP THAT MATCHES DEC EXP
	CAILE	E3,(E1)		;IS THIS POWER OF TEN .GT. FRACTION?
	JRST	EFMT4		;YES, IN THE EXPONENT
	CAIN	E3,(E1)		;MAYBE.
	CAML	T1,HITEN(E2)	;EXPONENTS ARE THE SAME COMPARE FRACT
	AOJA	E2,EFMT3	;POWER OF TEN IS ONE TOO SMALL

EFMT4:	CALL	FLODIV		;POWER OF TEN O.K., DO SCALING
	ASH	T1,-200(E1)	;SCALE FRACTION RIGHT

EFMT7:	PUSH	P,T1		;PRESERVE T1
	CALL	O$SPAC		;OUTPUT A SPACE
	POP	P,T1		;GRAB IT BACK
	MOVEI	P1,^D14		;LOAD FIELD WIDTH
	MOVEI	P2,^D8		;NO. OF DECIMAL PLACES
	MOVE	E2,P2		;
	MOVE	E1,P		;MARK BOTTOM OF STACK
	PUSH	P,[0]		;ALLOW FOR POSSIBLE OVERFLOW
	SKIPGE	E3,E2		;GET NUMBER OF DIGITS
	MOVEI	E3,0		;IF NEGATIVE ADD .5 TO FRACTION
	ADD	T1,RNDHGH(E3)	;ROUND TO CORRECT NUMBER OF DIGITS
	ADDI	T1,1		;ROUND A LITTLE MORE
	TLZN	T1,(1B0)	;DID CARRY PROPAGATE TO BIT 0
	AOS	(P)		;YES, PROPAGATE CARRY TO LEADING 0

EFMT11:	MULI	T1,^D10		;MULTIPLY BY 10
	PUSH	P,T1		;STORE DIGIT ON STACK
	MOVE	T1,T2		;SET UP NEW FRACTION
	SOJG	E3,EFMT11	;

	MOVEI	E3,2(E1)	;GET BASE OF STACKED DIGITS
	MOVE	E4,1(E1)	; 
	JUMPE	E4,EFMT14	;DID OVERFLOW OCCUR?
	SUBI	E3,1		;YES, MOVE BACK BASE POINTER
	ADDI	T4,1		;NO, INCREMENT EXPONENT
EFMT14:	MOVE	E5,P1		;GET WIDTH
	SUBI	E5,2(P2)	;SIGN,POINT,AND CHARS FOLLOWING
	SUBI	E5,4		;ALLOW FOR  E+00
FIT:	CAIG	E5,1		;SPACE FOR LEADING BLANKS?
	JRST	GO2ERF		;NO LEADING BLANKS
	CALL	O$SPAC		;OUTPUT ONE
	SOJA	E5,FIT		;UNTIL ENOUGH

GO2ERF:	JUMPN	E2,.+2		;CHECK FOR NO SIGNIFICANT DIGITS
	TLO	F,FL$FL2	;ENSURE ZEROS WILL BE PRINTED
	CALL	SIGN		;OUTPUT SIGN
	JUMPLE	E5,EFORM2	;NO SPACE LEFT FOR "0"
	CALL	ZERO		;OUTPUT ZERO
EFORM2:	CALL	O$DOT		;AND DECIMAL POINT
	CALL	DIGIT		;OUTPUT FRACTIONAL DIGIT
	SOJN	E2,.+2		;TOTAL COUNT EXPIRED?
	TLO	F,FL$FL2	;YES, FLAG DIGITS EXHAUSTED
	SOJG	P2,.-3		;RETURN IF MORE DIGITS

	MOVEI	T1,"E"		;
	CALL	O$CHAR		;OUTPUT E
	JUMPGE	T4,EFORM5	;ALWAYS + IF ZERO
	TLO	F,FL$NEG	;TRANSFER EXPONENT SIGN

EFORM5:	CALL	PLUS		;PRINT SIGN
	MOVEI	E5,2		;AND SET DIGIT COUNT
	MOVE	P,E1		;RESTORE STACK POINTER
	MOVM	T1,T4		;GET EXPONENT
	JRST	OUTP1		;

;OUTPUT

ZERO:	MOVEI	T1,"0"		;GET A ZERO
	PJRST	O$CHAR		;PRINT IT
PLUS:	SKIPA	T1,[EXP	"+"]	;LOAD UP A PLUS SIGN
SIGN:	MOVEI	T1," "		;
SIGN1:	TLZE	F,FL$NEG	;IS SIGN NEGATIVE?
	MOVEI	T1,"-"		;YES, SET IT
	PJRST	O$CHAR		;PRINT IT

DIGIT:	MOVEI	T1,"0"		;SET DIGIT TO ZERO
	TLNE	F,FL$FL2	;DO WE NEED TO PRINT A ZERO?
	PJRST	O$CHAR		;YES--PRINT IT
	MOVE	T1,(E3)		;GET A DIGIT
	ADDI	T1,"0"		;SET TO ASCII
	AOJA	E3,O$CHAR	;PRINT IT

OUTP1:	MOVEI	T4,1		;INITIALIZE DIGIT COUNT
OUTP2:	IDIVI	T1,^D10		; DIVIDE FRACTION BY TEN
	PUSH	P,T2		;SAVE DIGIT
	JUMPE	T1,OUTP3	;IS FRACTION ZERO YET?
	AOJA	T4,OUTP2	 ;NO, DO ALL DIGITS

OUTP3:	CAML	T4,E5		;YES, ANY LEADING SPACES?
	JRST	OUTP4		;NO
	CALL	ZERO		;YES, PRINT ONE
	SOJA	E5,OUTP3	;FINISH THEM
OUTP4:	POP	P,T1		;GET A DIGIT
	ADDI	T1,"0"		;SET TO ASCII
	CALL	O$CHAR		;PRINT IT
	SOJN	T4,OUTP4	;DO ALL OF THEM
	CALL	RESACS		;RESTORE ACS
	POPJ	P,		;DONE
SUBTTL	FLOATING POINT OUTPUT TABLES

RNDHGH:	600000,,000000
	414631,,463146
	401217,,270243
	400101,,422335
	400006,,433342
	400000,,517426
	400000,,041433
	400000,,003265
	400000,,000253
	400000,,000021
	400000,,000001
	400000,,000000
	400000,,000000
	400000,,000000
	400000,,000000
	400000,,000000
	400000,,000000
	400000,,000000
	400000,,000000
PTLEN=24
	274712,,041444
	354074,,451755
	223445,,672164
	270357,,250621
	346453,,122766
	220072,,763671
	264111,,560650
	341134,,115022
	214571,,460113
	257727,,774136
	333715,,773165
	211340,,575011
	253630,,734214
	326577,,123257
	206157,,364055
	247613,,261070
	321556,,135307
	203044,,672274
	243656,,135307
	314631,,463146
HITEN:	200000,,000000
	240000,,000000
	310000,,000000
	372000,,000000
	234200,,000000
	303240,,000000
	364110,,000000
	230455,,000000
	276570,,200000
	356326,,240000
	225005,,744000
	272207,,355000
	350651,,224200
	221411,,634520
	265714,,203644
	343277,,244615
	216067,,446770
	261505,,360566
	336026,,654723
	212616,,214044
	255361,,657055

	076101,,105110
	113117,,122125
	131134,,137143
	146151,,155160
	163167,,172175
EXP10:	201204,,207212
	216221,,224230
	233236,,242245
	250254,,257262
	266271,,274300
	303000,,000000
SUBTTL	FILE READING ROUTINES

;CALL GETBUF TO GET NEXT BUFFER
;GETBUF HANDLES THE DIFFERENT MODES AND SETS UP W AS AN AOBJN WORD TO THE
;DATA

GETBUF:	TLNE	F,FL$FOR	;FORTRAN BINARY?
	 JRST	RDFORT		;YES--GO TO IT
IFN FT$PHX,<
	TLNN	DC,(DV.MTA)	;MTA INPUT?
	 TLNN	F,FL$PHY	;NO--/IREAD?
	  CAIA			;MTA OR DIR AND NOT /IREAD
	  JRST	RDPHYX		;DIR DEV AND /IREAD
>;END IFN FT$PHX
	CALL	XCTIO		;GET A BUFFER FULL
	 IN	INPC,		;
	POPJ	P,		;END OF FILE
	HRRZ	W,IBHR+.BFPTR	;START THE AOBJ WORD
	MOVEI	W,1(W)		;POINT AT DATA
	MOVN	T1,IBHR+.BFCTR	;GET WORD COUNT
	HRL	W,T1		;FINISH W
	JRST	$POPJ1		;RETURN

IFN FT$PHX,<
RDPHYX:	CALL	.SAVE2##	;NEED A COUPLE OF REGISTERS
PHYX.0:	CALL	INPWRD		;GET IREAD WORD COUNT
	POPJ	P,		;EOF
	JUMPE	T1,PHYX.0	;NO SUCH THING AS ZERO WORD COUNT
	TLNE	T1,-1		;OR MORE THAN 2**18 WORDS/RECORD
	 JRST	E$$IFU		;**IREAD FILE IS MESSED UP
	CAMLE	T1,BUFSIZ	;MUST BE LESS THAN THIS
	 JRST	PHXLRG		;NO--TELL ABOUT LARGE RECORD AND FINISH UP
PHYX.4:	MOVNS	T1		;NEGATE IT
	HRLZ	T2,T1		;FORM AOBJ WORD
	HRR	T2,FORADR	;POINT TO THE BUFFER
	MOVE	W,T2		;W IS SETUP NOW
	MOVN	P1,T1		;GET WORD COUNT AS POSITIVE
	HRRZ	P2,T2		;GET BUFFER ADDRESS

PHYX.2:	SKIPLE	T4,IBHR+.BFCTR	;GET WORD COUNT--ARE ANY WORDS LEFT?
	 JRST	PHYX.3		;YES--GO USE THEM
	CALL	XCTIO		;NO--NEED A BUFFER
	 IN	INPC,		;XCT'D
	 SKIPA			;EOF ALREADY?
	JRST	PHYX.2		;PICK UP THE WORD COUNT
	ERROR.	EF$FTL,EBE,<EOF BEFORE END OF IREAD RECORD>
PHYX.3:	CAMLE	T4,P1		;ARE THERE MORE THAN WHAT WE NEED?
	 MOVE	T4,P1		;YES--ONLY USE WHAT WE NEED
	MOVS	T1,IBHR+.BFPTR	;BEGIN THE BLT CTL WORD
	HRRI	T1,-1(P2)	;FORM OTHER HALF (-1 FOR NEXT INSTR)
	AOBJP	T1,.+1		;EVERYTHING IS OFF BY ONE
	ADDM	T4,IBHR+.BFPTR	;INCREMENT PTR TO NEXT FREE WORD
	ADDM	T4,P2		;ALSO ADJUST FORADR PTR
	MOVNS	T4		;MAKE COUNT NEGATIVE
	ADDM	T4,P1		;DECREMENT WORD REQUIRED
	ADDM	T4,IBHR+.BFCTR	;DECREMENT BUFFER TOTAL
	BLT	T1,-1(P2)	;XFR THE WORDS
	JUMPG	P1,PHYX.2	;JUMP IF NOT FINISHED WITH RECORD
	JRST	$POPJ1		;DONE
E$$IFU:	ERROR.	EF$FTL,IFU,<IREAD FILE MESSED UP>
;HERE WHEN RECORD TOO LARGE READING DISK IREAD FILE

PHXLRG:	CALL	LRGERR		;TELL USER AND DUMP FILE ABOUT IT
	MOVN	T2,BUFSIZ	;GET - MAX BUFFER SIZE
	ADD	T2,T1		;COMPUTE # WORDS EXTRA IN RECORD
	SAVE$	T2		;SAVE WHILE WE COPY REST OF RECORD
	MOVE	T1,BUFSIZ	;SETUP T1 TO MAX RECORD SIZE
	CALL	PHYX.4		;COPY FIRST PART (FILL FORBUF)
	 JRST	E$$IFU		;SNH
	RESTR$	T2		;COMPUTE # WORDS WE MUST SKIP
PHXL.2:	CALL	INPWRD		;GET ONE
	 JRST	E$$IFU		;SNH
	SOJG	T2,PHXL.2	;EAT THEM ALL
	JRST	$POPJ1		;RETURN WITH ALL THAT WE COULD EAT
>;END IFN FT$PHX

;CALL HERE TO REPORT RECORD TOO LARGE TO TTY AND DUMP FILE
;T1 CONTAINS SIZE OF RECORD THAT WAS TOO LARGE

LRGERR:	CALL	FRCTYO		;FORCE TTY OUTPUT (SO CRLF IS CORRECT)
	CALL	.TCRLF##	;NEW LINE TO TTY (.TCRLF PRESERVES T1!)
	CALL	RTLERR		;REPORT RECORD IN ERROR TO TTY
	TRNE	DC,(DV.TTY)	;IF TTY OUTPUT FILE
	 POPJ	P,		;DON'T TELL HIM (HER) TWICE
	SAVE$	T1		;SAVE RECORD SIZE
	CALL	O$CRLF		;FIRST SET TO NEW LINE
	CALL	O$CRLF		;AND SKIP ONE SO MESSAGE STANDS OUT
	MOVEI	T1,O$CHAR	;SET MY OUTPUT ROUTINE
	CALL	.TYOCH##	;WITH .TOUTS
	EXCH	T1,(P)		;SAVE OLD ROUTINE, RESTORE SIZE
	SETOM	ERRTYX		;FLAG EHNDLR NOT TO SWITCH OUTPUTS
	CALL	RTLERR		;REPORT LARGE RECORD TO DUMP FILE
XCHTYO:	EXCH	T1,(P)		;...
	CALL	.TYOCH##	;RESTORE SCANS OUTPUT
	JRST	TPOPJ		;RESTORE T1 AND RETURN

RTLERR:	WARN.	EF$DEC!EF$NCR,RTL,<RECORD TOO LARGE - >
	CALL	TYFREC		;TYPE FILE AND RECORD LOCATION
	PJRST	.TCRLF##	;NEW LINE AND EXIT
TYFREC:	SAVE$	T1		;SAVE SIZE
	STRNG$	< - FILE >
	MOVE	T1,FILE
	CALL	.TDECW##
	STRNG$	< RECORD >
	MOVE	T1,RECORD
	AOJ	T1,		;REALLY C(RECORD)+1
	CALL	.TDECW##
	PJRST	TPOPJ		;RESTORE SIZE AND RETURN
;CALL HERE TO GET ONE WORD FROM INPUT FILE
;CPOPJ1 WITH WORD IN T1 OR CPOPJ IF EOF

INPWRD:	SOSGE	IBHR+.BFCTR	;ANY WORDS AT ALL?
	 JRST	INPW.1		;NO--GET SOME
	ILDB	T1,IBHR+.BFPTR	;YES--GET IT
	JRST	$POPJ1
INPW.1:	CALL	XCTIO		;GET A BUFFER
	 IN	INPC,
	  POPJ	P,		;EOF
	JRST	INPWRD		;GET A WORD NOW

;CALL HERE TO FORCE OUTPUT TO TTY IF OUTPUT OPEN AND TTY IS OUTPUT FILE

FRCTYO:	TLNN	F,FL$OPN	;OUTPUT FILE OPEN?
	 POPJ	P,		;NO--DONT GET UNASSIGNED CHANNEL IO
	TRNE	DC,(DV.TTY)	;TTY DUMP?
	OUTPUT	OUTC,		;YES--MAKE MESSAGE APPEAR IN RIGHT PLACE
	POPJ	P,
SUBTTL	READ FORTRAN BINARY RECORDS 

RDFORT:	CALL	.SAVE1##	;NEED A REGISTER
	SETZ	W,		;CLEAR WORD COUNT
	MOVE	P1,FORADR	;POINT AT THE ARRAY
	TLZ	F,FL$TMP!FL$FL2 ;FL$TMP IS THE "SAW TYPE 1 LSCW" FLAG
				;FL$FL2 IS THE "RECORD TOO LARGE" FLAG

RFOR.1:	CALL	INPWRD		;GET A WORD
	POPJ	P,		;END OF FILE
RFOR.3:	TLNN	T1,CW$ANY	;IS IT AN LSCW
	 JRST	FORSRC		;NO--GO FIND ONE
	TLNN	T1,CW$1O3	;TYPE 1 OR 3?
	 JRST	FORCW2		;NO--TYPE 2
	TLNE	T1,CW$TY3	;TYPE 3?
	 JRST	FORCW3		;YES

;HERE TO DO FORTRAN TYPE 1 LSCW

FORCW1:	TLO	F,FL$TMP	;FLAG WE SAW ONE
FORCON:	MOVE	T2,T1		;COPY LSCW
	MOVEI	T1,-1(T1)	;GET DATA WORD COUNT
	ADD	W,T1		;UPDATE WORD COUNT
	TLNE	F,FL$FL2	;ARE WE IN A LARGE RECORD?
	 JRST	RFOR.5		;YES--SKIP AHEAD
	CAMLE	W,BUFSIZ	;ROOM IN BUFFER?
	 JRST	FORLRG		;NO--GO FIXUP
	HRL	T1,IBHR+.BFPTR	;GET LH OF BLT
	HRRI	T1,-1(P1)	;RH--(-1 SO WE CAN AOBJN)
	AOBJN	T1,.+1		;MAKE IT RIGHT
	ADD	P1,T2		;COMPUTE END OF BLT
RFOR.4:	BLT	T1,-1(P1)	;MOVE WORDS
RFOR.5:	MOVEI	T1,-1(T2)	;COUNT DATA WORDS EATEN
	ADDM	T1,IBHR+.BFPTR
	MOVNI	T1,-1(T2)	;...
	ADDM	T1,IBHR+.BFCTR
	JRST	RFOR.1		;CONTINUE

FORCW2:	TLNN	F,FL$TMP	;SEEN A TYPE 1?
	 JRST	FORSRC		;NO--GO FIND ONE
	JRST	FORCON		;YES--CONTINUE COPYING RECORD

FORCW3:	TLZN	F,FL$FL2	;WAS RECORD TOO LARGE?
	 JRST	FOR3.X		;NO--EXIT GRACEFULLY
	MOVE	T1,W		;YES--GET RECORD SIZE
	CALL	LRGERR		;REPORT LARGE RECORD
	HRRZ	W,BUFSIZ	;SET TO RETURN ONLY MAX
FOR3.X:	MOVN	W,W		;BEGIN TO COMPUTE AOBJN TO FORADR
	HRLZS	W
	HRR	W,FORADR	;NOW WE ARE DONE
	JRST	$POPJ1		;SKIP BACK

FORSRC:	CALL	INPWRD		;GET A WORD
	ERROR.	EF$FTL,IFF,<INCORRECTLY FORMATTED FORTRAN FILE>
	TLNN	T1,776000	;ANY LS?
	TLNN	T1,1000		;TYPE 1?
	 JRST	FORSRC		;NOPE
	MOVE	T2,BUFSIZ	;YES--GET /BUFSIZ
	CAIGE	T2,(T1)		;CAN IT BE?
	 JRST	FORSRC		;NOPE
	HRRZ	T2,IBHR+.BFCTR	;GET WHAT IS LEFT IN BUFFER
	CAIE	T2,-1(T1)	;THE SAME?
	JRST	FORSRC		;NO
	HRRZ	T2,IBHR+.BFPTR	;GET PTR
	ADDI	T2,(T1)		;COMPUTE WHERE NEXT LSCW IS
	MOVE	T2,@T2		;GET IT
	TLNN	T2,774000	;IS IT AN LSCW?
	 TLNN	T2,CW$ANY	;IS IT ANY LSCW?
	  JRST	FORSRC		;NOT YET
	JRST	RFOR.3		;YES--GO PROCESS IT

;HERE WHEN WE SEE THAT THE RECORD IS TOO LARGE

FORLRG:	TLO	F,FL$FL2	;FLAG FOR FORCW3 THAT RECORD IS TOO LARGE
	HRL	T1,IBHR+.BFPTR	;GET SET TO MOVE WHAT WE CAN FROM THIS RECORD
	HRRI	T1,-1(P1)	;...
	AOBJN	T1,.+1		;FIX PTR
	HRRZ	P1,FORADR	;COMPUTE END OF BUFFER
	ADD	P1,BUFSIZ	;...
	JRST	RFOR.4		;GO MOVE WHAT WE CAN AND SKIP REST
SUBTTL	POSITIONING FUNCTIONS

D$SKP:	TLNE	F,FL$OUT	;WHICH SIDE?
	TLNN	DC,(DV.DIR)	;INPUT--IS THIS DIRECTORY?
	 TRNE	DC,(DV.DIR)	;OUTPUT--IS THIS DIRECTORY?
	  JRST	SKPDIR		;DIRECTORY--GO SKIP IT
	TLNE	F,FL$FOR	;MTA--IS IT FORTRAN SKIP?
	 JRST	SKMFOR		;YES--DO IT
	ADDM	P1,FILE		;INCREMENT FILE COUNT
	ADDM	P2,RECORD	;AND RECORD COUNT
	MOVE	T1,[MTSKF.]	;GET FILE MTAPE
	MOVE	T2,[MTSKR.]	;AND RECORD MTAPE
DSKP.G:	CALL	SETIOC		;SET I/O CHANNELS IN
	CALL	SKPFLR		;DO THEM
	JRST	DMPLUP		;CONTINUE

;HERE TO SKIP FORTRAN BINARY ON MTA

SKMFOR:	MOVE	T1,[MTSKF.]	;SKIP FILES
	CALL	SETIOC		;SETUP FOR IT
SKMF.1:	XCT	T1		;SKIP ONE FILE
	XCT	T3		;WAIT FOR IT
	AOS	FILE		;COUNT THE FILE
	SOJG	P1,SKMF.1	;DO ALL NEEDED
	JRST	SKDFOR		;GO SKIP RECORDS AND FINISH UP

SETIOC:	TLNE	F,FL$OUT	;INPUT OR OUTPUT?
	 JRST	SETI.1		;INPUT
	TLO	T1,(Z OUTC,)	;SET IN CHANNEL
	TLO	T2,(Z OUTC,)	;...
	MOVE	T3,[MTWAT. OUTC,] ;SET INSTR TO WAIT ON I/O
	POPJ	P,
SETI.1:	TLO	T1,(Z INPC,)	;INPUT CHANNEL
	TLO	T2,(Z INPC,)
	MOVE	T3,[MTWAT. INPC,] ;INSTR TO WAIT ON I/O
	POPJ	P,

SKPFLR:	JUMPLE	P1,SKPL.1	;JUMP IF NO FILE ACTION
SKPL.0:	XCT	T1		;DO IT
	XCT	T3		;WAIT FOR OP TO FINISH
	SOJG	P1,SKPL.0	;ALL REQUESTED TIMES
SKPL.1:	JUMPLE	P2,$POPJ	;JUMP IF NO RECORDS
SKPL.2:	XCT	T2
	XCT	T3		;WAIT FOR I/O
	SOJG	P2,SKPL.2
	POPJ	P,

SKPDIR:	JUMPG	P1,E$$SFI	;SKIPPING FILES IS HIGHLY ILLEGAL
	TLNE	F,FL$FOR!FL$PHY	;FORTRAN OR PHYSICS?
	 JRST	SKDFOR		;YES
	SKIPN	T1,RECORD	;WHERE ARE WE NOW?
	 MOVEI	T1,1		;MUST BE AT THE BEGINNING
	ADDI	T1,-1(P2)	;COMPUTE NEW RECORD
	CAMLE	T1,IFILSZ	;DON'T USETI PAST EOF
	MOVE	T1,IFILSZ	;...
	MOVEM	T1,RECORD	;...
	USETI	INPC,1(T1)	;SET TO READ IT
	CALL	CLRUSE		;CLEAR USE BITS FOR FRESH READ
	JRST	DMPLUP		;CONTINUE EXECUTING FNS

SKDFOR:	TLO	F,FL$MNP	;FLAG MANIPULATING
SKDF.1:	CALL	GETBUF		;READ A RECORD
	 JRST	DMPEND		;END IT ALL
	AOS	RECORD		;COUNT THE RECORD
	SOJG	P2,SKDF.1	;DO ALL REQUESTED
	TLZ	F,FL$MNP	;NOT MANIPULATING ANY MORE
	JRST	DMPLUP		;CONTINUE
E$$SFI:	ERROR.	EF$FTL,SFI,<SKIP/BACKSPACE FILES ILLEGAL ON DIRECTORY DEVICE>

D$BSP:	
	TLNE	F,FL$OUT	;INPUT OR OUTPUT?
	TLNN	DC,(DV.DIR)	;INPUT--IS IT A DIR DEV?
	 TRNE	DC,(DV.DIR)	;OUTPUT--IS IT A DIR DEV?
	 JRST	BSPDIR		;DIR DEV--GO DO IT
	TLNE	F,FL$FOR	;IS IT /FORTRAN?
	JRST	E$$SFM		;CANT
	MOVN	T1,P1		;UPDATE FILE AND RECORD
	ADDM	T1,FILE		;COUNTS
	MOVN	T1,P2		;...
	ADDM	T1,RECORD
	MOVE	T1,[MTBSF.]	;SETUP OPS
	MOVE	T2,[MTBSR.]
	JRST	DSKP.G		;GO DO IT AND RETURN

E$$SFM:	ERROR.	EF$FTL,SFM,<CANT BACKSPACE MTA WITH /FORTRA>

BSPDIR:	JUMPG	P1,E$$SFI	;CAN'T SKIP MULTIPLE FILES ON DIR DEV
	TLNN	F,FL$OUT	;NOR ON OUPTUT DEVICE
	 JRST	E$$BSO		;GO DIE
	SKIPN	T1,RECORD	;WHERE ARE WE?
	 MOVEI	T1,1		;DON'T KNOW--MUST BE AT START OF FILE
	SUB	T1,P2		;COMPUTE NEW POSITION
	SKIPG	T1		;PAST BEGINNING OF FILE?
	 MOVEI	T1,1		;YES--SET FOR FIRST RECORD
	TLNE	F,FL$FOR!FL$PHY	;FORTRAN OR PHYSICS?
	 JRST	BSPFOR		;YES--GO HANDLE IT
	USETI	INPC,(T1)	;POSITION MYSELF THERE
	SOS	T1		;ONE LESS TO STORE IN RECORD
	MOVEM	T1,RECORD	;WILL GET UPDATE AT RECHDR
	CALL	CLRUSE		;CLEAR USE BITS
	JRST	DMPLUP

E$$BSO:	ERROR.	EF$FTL,BSO,<CANT BACKSPACE DISK OUTPUT>

BSPFOR:	MOVE	P2,T1		;POSITION # RECS TO SKIP
	USETI	INPC,1		;POSITION TO FILE START
	CALL	CLRUSE		;CLEAR USE BITS
	SETZM	RECORD		;RESET
	SOJLE	P2,DMPLUP	;JUMP IF WE ARE IN PROPER POSITION
	JRST	SKDFOR		;NO--GO SKIP SOME RECORDS

;HERE TO PROCESS /REWIND

D$REW:	TLNN	F,FL$OUT	;OUTPUT SIDE?
	TRNE	DC,(DV.MTA)	;YES--IS IT A MAGTAPE
	 CAIA			;INPUT DEVICE OR OUTPUT IS MTA
	ERROR.	EF$FTL,CRD,<CANNOT REWIND DISK OUTPUT>
	SETZM	FILE		;CLEAR FILE AND RECORD
	SETZM	RECORD		;...
	TLNE	F,FL$OUT	;INPUT SIDE?
	TLNN	DC,(DV.DIR)	;A DIRECTORY DEVICE?
	 JRST	REWMTA		;OUTPUT OR INPUT NOT DIRECTORY
	USETI	INPC,1		;SET TO READ FIRST BLOCK
	CALL	CLRUSE		;CLEAR THE USE BITS IN THE RING
	JRST	DMPLUP		;DO NEXT COMMAND
REWMTA:	MOVE	T1,[MTREW.]	;SET UP FUNCTION
	TLNE	F,FL$OUT	;INPUT OR OUTPUT?
	 TLOA	T1,(Z INPC,)	;INPUT SIDE
	  TLO	T1,(Z OUTC,)	;OUTPUT SIDE
	XCT	T1		;REWIND THE DEVICE
	JRST	DMPLUP		;NEXT COMMAND

D$RIB:	TLNE	F,FL$OUT	;MUST BE INPUT SIDE
	 TLNN	DC,(DV.DSK)	;AND ON THE DSK
  	ERROR.	EF$FTL,RIB,</RIB ILLEGAL ON OUTPUT OR ILLEGAL DEVICE FOR /RIB>
	USETI	INPC,0		;POSITION TO READ THE RIB
	CALL	CLRUSE		;CLEAR THE USE BITS
	JRST	DMPLUP		;BACK FOR MORE

D$ONL:	JUMPL	P1,E$$ONL	;CHECK FOR BAD NUMBERS
	JUMPL	P2,E$$ONL	;..
	MOVE	T1,P1		;NOW SEE IF /ONLY WITH NO ARGS
	TSO	T1,P2		;WHICH MEANS TO TURN OFF THE MODE
	JUMPE	T1,D$ONLF	;SO GO DO THAT
	CAMGE	P2,P1		;END MUST BE AT LEAST AS BIG AS BEGINNING
	 JRST	E$$ONL		;LOOSE
	SKIPN	P1		;MAKE SURE WE HAVE AT LEAST ONE
	MOVEI	P1,1		;...
	MOVEM	P1,ONLYLO	;SAVE LOW LIMIT
	MOVEM	P2,ONLYHI	;AND HIGH LIMIT
	TLOA	F,FL$OLY	;TELL DUMPIT WE ARE ONLY DUMPING PARTIAL REC
D$ONLF:	TLZ	F,FL$OLY	;HERE WE TURN OFF IF /ONLY OR /ONLY:0
	JRST	DMPLUP		;CONTINUE FUNCTIONS
E$$ONL:	ERROR.	EF$FTL,OIS,</ONLY INCORRECTLY SPECIFIED>

CLRUSE:	WAIT	INPC,		;WAIT FOR THINGS TO SETTLE OUT
	HRRZ	T1,IBHR+.BFADR	;START AT THE BEGINNING
	HRRZ	T2,T1		;COPY TO MOVE AROUND
	MOVSI	T3,(BF.IOU)	;BIT TO CLEAR
CLRU.1:	ANDCAM	T3,(T2)		;CLEAR THE USE BIT
	HRRZ	T2,(T2)		;MOVE TO NEXT
	CAMN	T2,T1		;DONE?
	JRST	CLRU.1		;NO
	MOVSI	T3,(BF.VBR)	;YES--NOW FIX BUFFER HEADER
	IORM	T3,IBHR+.BFADR
	POPJ	P,		;ALL DONE
SUBTTL	ATTEND TO TTY INPUT WHILE RUNNING

;CHKTTY -- SEE IF A COMMAND TYPED WHILE RUNNING
;CALL:	CALL	CHKTTY
;	*SAID TO KILL*
;	*KEEP GOING*

CHKTTY:	TLNE	F,FL$ITY	;/IFTYP
	 INCHRS	T1		;YES--GET CHAR IF THERE
	  JRST	$POPJ1		;NO /IFTYP OR NO CHAR
	CLRBFI			;EAT WHAT MIGHT BE LEFT
	MOVSI	T2,-N$IFTC	;AOBJN COUNTER
	CAME	T1,IFTCMD(T2)	;THIS IT?
	 AOBJN	T2,.-1
	JUMPL	T2,@IFTDSP(T2)	;JUMP IF FOUND A GOOD ONE
	MOVEI	T1,.CHBEL	;NO--GET A BELL
	AOS	(P)		;SET TO SKIP BACK
	PJRST	.TCHAR##	;TYPE BELL AND CONTINUE

IFTCMD:	EXP	"I"		;IGNORE IFTYP
	EXP	"K"		;KILL COMMAND
	EXP	"P"		;PAUSE COMMAND
	N$IFTC==.-IFTCMD

IFTDSP:	EXP	IFTIGN		;IGNORE
	EXP	$POPJ		;KILL
	EXP	CHKT.P		;PAUSE

IFTIGN:	TLZ	F,FL$ITY	;CLEAR /IFTYP
	PJRST	$POPJ1		;SKIP BACK

CHKT.P:	CALL	.TCRLF##	;NEW LINE
	INFO.	0,PTC,<PAUSING--TYPE ANY CHARACTER TO CONTINUE>
	AOS	(P)		;SKIP BACK
GCHNWL:	CLRBFI			;CLEAR INPUT
	INCHRW	T1		;GET A CHARACTER
	CLRBFI			;EAT REAST
	OUTSTR	[ASCIZ/
/]
	POPJ	P,		;RETURN
SUBTTL	OPEN I/O CHANNELS
;OPENIO
;CALL:	MOVEI	T1,<FDB ADDR>
;	CALL	OPENIO
;	CAI	CHANNEL,BUFADR	;@ IF OUTPUT, (MODE)
;	*ALL IS WELL RETURN*	;ABORT IF FAIL

OPENIO:	HRL	T1,0(P)		;REMEMBER CALLER
	AOS	0(P)		;SKIP ARGS ON RETURN
	CALL	.SAVE3##	;PRESERVE REGISTERS
	MOVS	P1,T1		;COPY ARGUMENTS
	MOVE	P2,(P1)		;GET REST OF THEM
	STORE	T1,OPNBLK,LKPBLK+.RBTIM,0 ;CLEAR ANY RESIDUE IN BLOCK
	MOVSI	T1,.FXLEN	;SETUP FOR .STOPB
	HLR	T1,P1		;...
	MOVEI	T2,OPNBLK	;
	SKIPA	T3,.+1
	.RBTIM+1,,LKPBLK
	MOVEI	T4,PTHBLK
	CALL	.STOPB##	;CONVERT TO OPEN/LOOKUP BLOCKS
	 JRST	WLDERR		;NO WILDCARDING!
	MOVEI	T1,.RBTIM	;SETUP COUNT
	MOVEM	T1,LKPBLK+.RBCNT
	LDB	T1,[POINT 4,P2,17] ;GET MODE
	MOVEM	T1,OPNBLK	;STORE IN OPEN BLOCK
	HRRZ	T1,P2		;BUFFER HEADER ADDRESS
	TLNE	P2,ATSIGN	;READ OR WRITE?
	MOVSS	T1		;WRITING, POSITON FOR IT
	MOVEM	T1,OPNBLK+.OPBUF;STORE
	LDB	P3,[POINT 4,P2,12] ;GET I/O CHANNEL
	LSH	P3,5		;POSITION
	MOVSS	P3		;IN CHANNEL POSITION
	MOVE	T1,[OPEN OPNBLK];FORM INSTR
	OR	T1,P3		;FINISH
	XCT	T1		;TRY TO OPEN DEVICE
	 JRST	OPENER		;CAN'T--BOMB OUT

	MOVE	T1,P3		;REGET I/O CHANNEL
	TLNE	P2,ATSIGN	;READ/WRITE?
	 TLOA	T1,(ENTER)	;WRITE
	  TLO	T1,(LOOKUP)	;READ
	HRRI	T1,LKPBLK	;COMPLETE INSTR
	XCT	T1		;FIND/WRITE THE FILE
	 JRST	LKENER		;CAN'T
	POPJ	P,		;DONE
;OPENIO ERRORS

OPENER:	HLRZ	T1,P1		;COPY FDB ADDR
	ERROR.	EF$FTL!EF$FIL,COD,<CAN'T OPEN DEVICE, FILE >

WLDERR:	HLRZ	T1,P1		;GET FDB
	ERROR.	EF$FTL!EF$FIL,WFI,<WILDCARD FILESPEC ILLEGAL, FILE >

LKENER:	HRRZ	T1,LKPBLK+.RBEXT;GET FAIL CODE
	ERROR.	EF$ERR!EF$OCT!EF$NCR,LER,<LOOKUP/ENTER ERROR(>
	STRNG$	<) FILE >
	HLRZ	T1,P1
	CALL	.TFBLK##	;TYPE SCAN BLOCK
	CALL	.TCRLF##	;NEW LINE
	JRST	ERRFTL		;GO DIE
SUBTTL	XCTIO EXECUTES IN/OUT UUO WITH ERROR HANDLING

;XCTIO
;CALL:	CALL	XCTIO
;	<INSTR TO XCT>	;IN/OUT UUO
;	*EOF/EOT RETURN*
;	*NORMAL RETURN*

XCTIO:	XCT	@0(P)		;DO THE INSTR
	 JRST	$POPJ2		;OK--SKIP 2 AND RETURN
	SAVE$	T1		;OOPS--SAVE T1
	MOVE	T1,@-1(P)	;GET INSTR WE FAILED ON
	AOS	-1(P)		;SKIP INSTR ON WAY BACK
XCTIOE:	AND	T1,[17B12]	;ERROR--GET THE CHANNEL
	PUSH	P,T3		;SAVE T3 A SECOND
	MOVE	T3,T1		;GET CHANNEL
	OR	T3,[WAIT]	;WAIT FOR I/O TO CEASE
	XCT	T3		;DO IT NOW
	POP	P,T3		;GET T3 BACK
	OR	T1,[GETSTS T2]	;GET ERRROR BITS
	XCT	T1
	TRNE	T2,IO.EOF!IO.EOT;END OF SOMETHING?
	JRST	TPOPJ		;YES
	EXCH	T1,T2		;NO--GET BITS IN RIGHT PLACE, SAVE I/O INSTR
	HRR	T2,T1		;PUT BITS IN THE INSTR
	TRZ	T2,IO.ERR	;CLEAR ERROR BITS
	TLZ	T2,002000	;BY MAJIK, A GETSTS BECOMES A SETSTS
	XCT	T2		;CLEAR THE ERROR BITS
	LDB	T2,[POINT 4,T2,12] ;GET IO CHANNEL
	SAVE$	T2		;SAVE CHAN ON PDL
	CAIE	T2,INPC		;INPUT?
	 JRST	XCTI.1		;NO--ALWAYS MESSAGE THEM
	TLNN	F,FL$MNP	;READING TO SKIP?
	 SKIPLE	FLNTRY		;OR NOT /NORETRY
	 JRST	ETPJ1		;ONE OR THE OTHER GETS NO MESSAGE
	MOVE	T2,FLERR	;GET /ERROR VALUE
	CAIN	T2,ERRIGN	;IS IT /ERROR:IGNORE?
	 JRST	ETPJ1		;YES--DON'T GRIPE
XCTI.1:	RESTR$	T2		;GET CHAN BACK
	CALL	TELIOE		;TELL OF THE ERROR
	SKIPLE	T1,FLERR	;GET /ERROR:ARG FLAG
	 CAIE	T1,ERRQUE	;WAS IT /ERROR:QUERY?
	  JRST	XIOCON		;NO--TELL CONTINUING AND EXIT THIS CALL
	JRST	GEROPT		;YES--SEE WHAT HE (SHE) WANTS TO DO
TELIOE:	CALL	FRCTYO		;FORCE TTY OUTPUT
	CALL	.TCRLF##	;NEW LINE
	CALL	TELIO1		;TELL TO USERS TTY
	CAIN	T2,INPC		;IF NOT INPUT CHANNEL OR,
	TRNE	DC,(DV.TTY)	;IF OUTPUT IS ALSO TO TTY
	 POPJ	P,		;THEN WE ARE DONE
	SAVE$	T1		;NO--SAVE T1
	CALL	O$CRLF		;NEW LINE
	CALL	O$CRLF		;AND ANOTHER
	MOVEI	T1,O$CHAR	;SETUP ROUTINE
	CALL	.TYOCH##	;WITH SCAN
	EXCH	T1,(P)		;REMEMBER OLD ONE
	SETOM	ERRTYX		;TELL EHNDLR TO NOT SWITCH THEM NOW
	CALL	TELIO1		;TELL ERROR TO LISTING
	PJRST	XCHTYO		;FIXUP OUTPUT AND RETURN

TELIO1:	WARN.	EF$NCR!EF$OCT,IOE,<I/O ERROR - STATUS=>
	CALL	TELPRB		;DECODE BITS FOR USER
	SAVE$	T1		;SAVE STATUS
	STRNG$	<, FILE >
	MOVEI	T1,OUTSPC	;ASSUME OUTPUT ERROR
	SAVE$	T2		;SAVE CHAN
	CALL	@[EXP TINSPC,.TFBLK##]-1(T2) ;TYPE THE FILE SPEC
	CALL	TYFREC		;TYPE FEET AND RECORDS
	RESTR$	T2		;GET CHANN BACK
	CALL	.TCRLF##	;NEW LINE
	JRST	TPOPJ		;RESTORE T1 AND RETURN

$POPJ2:	AOS	(P)		;SKIP 2
$POPJ1:	AOS	(P)		;SKIP 1
$POPJ:	POPJ	P,		;SKIP 0
;HERE WITH ERROR BITS IN T1--DECODE THEM
;USES NO ACS

TELPRB:	CALL	.PSH4T##	;PRESERVE ACS
	MOVE	T4,T1		;COPY BITS
	ANDI	T4,IO.IMP!IO.DER!IO.DTE!IO.BKT ;GET ONLY ERROR BITS
	JUMPE	T4,PRBDUN	;JUMP IF NOT A PROBLEM
	LSH	T4,-<ALIGN. (IO.BKT)> ;LINE UP
	MOVEI	T1,[ASCIZ/ (/]	;START
	CALL	.TSTRG##
	TLZ	F,FL$IOF	;CLEAR A FLAG
	MOVE	T3,[POINT 18,PRBNAM] ;INIT A PTR
PRBLUP:	ILDB	T2,T3		;GET A NAME
	TRNN	T4,1		;IS THIS  A PROBLEM?
	JRST	PRBNXT		;NO
	TLOE	F,FL$IOF	;YES--IS IT FIRST?
	 CALL	TYSLSH		;NO--TYPE A SLASH
	MOVSI	T1,(T2)		;POSITION CODE
	CALL	.TSIXN##	;SEND IT
PRBNXT:	LSH	T4,-1		;MOVE OVER
	JUMPN	T4,PRBLUP	;JUMP IF MORE PROBLEMS
	MOVEI	T1,")"		;NO--FINISH
	CALL	.TCHAR##
PRBDUN:
POP4J:	CALL	.POP4T##	;RESTORE REGS
	POPJ	P,		;AND RETURN

PRBNAM:	'BKTPAR'		;BLOCK TOO LARGE/PARITY ERROR
	'DERIMP'		;DEVICE ERROR/WRITE LOCKED
	EXP	0		;SNH
GEROPT:	STRNG$	<
OPTION (H FOR HELP): >
	CALL	GCHNWL		;GET HIS ANSWER IN T1
	MOVSI	T2,-N$EOPT	;GET LOOP COUNT
	CAME	T1,ERROPT(T2)	;IS THIS IT?
	 AOBJN	T2,.-1		;NO--CHECK ALL
	JUMPL	T2,@ERRDSP(T2)	;JUMP IF FOUND A MATCH
	JRST	GEROPT		;ELSE ASK AGAIN

ERROPT:	EXP	"C"		;CONTINUE
	EXP	"H"		;GIVE SOME HELP
	EXP	"I"		;IGNORE FROM NOW ON
	EXP	"Q"		;QUIT (FAKE AN EOF)
	EXP	"S"		;SKIP THIS RECORD
N$EOPT==.-ERROPT

ERRDSP:	EXP	XIOCON		;CONTINUE
	EXP	GVEHLP		;GIVE HELP
	EXP	ERIGNR		;IGNORE ERRORS FROM NOW ON
	EXP	ERQUIT		;QUIT
	EXP	ERSKIP		;SKIP THIS RECORD

;HERE TO SET /ERROR:IGNORE

ERIGNR:	MOVEI	T1,ERRIGN	;GET VALUE
	MOVEM	T1,FLERR	;

XIOCON:
TPOPJ1:	RESTR$	T1		;GET T1 AGAIN
	AOSA	(P)
TPOPJ:	RESTR$	T1
	POPJ	P,
ETPJ1:	POP	P,(P)		;CLEAR CRUD ON PDL
	JRST	TPOPJ1		;AND RESTORE T1 AND RETURN

;HERE TO GIVE SOME HELP

GVEHLP:
IFE FT$SEG,<CALL UPSCN>		;MAKE HISEG ADDRESSABLE
	OUTSTR	ERRHLM		;GIVE THE HELP
IFE FT$SEG,<CALL DWNSCN>	;REMOVE CORE ONCE MORE
	JRST	GEROPT

	IFE FT$SEG,<HIGH$>	;PUT MESSAGE IN SHARABLE HISEG
ERRHLM:	ASCIZ$	<TYPE ONE OF:
C - CONTINUE (DUMP THIS RECORD)
H - TYPE THIS
I - CONTINUE AND MAKE IT /ERROR:IGNORE
Q - QUIT NOW
S - SKIP THIS RECORD (DO NOT DUMP IT)
>
	IFE FT$SEG,<LOW$>	;BACK TO LOWSEG 

;HERE TO QUIT

ERQUIT:	SETZB	P1,P2		;FORCE AND END TO IT ALL
	JRST	TPOPJ		;RETURN EOF

;HERE TO SKIP THIS RECORD

ERSKIP:	AOS	RECORD		;COUNT RECORD WE SKIPPED
	MOVE	T1,-1(P)	;GET ADDRESS +1 
	MOVE	T1,-1(T1)	;GET INSTR
	 XCT	T1		;CLANK IT AGAIN
	 JRST	TPOPJ1		;OK--RETURN
	 JRST	XCTIOE		;JUST CAN'T WIN...
SUBTTL	ERROR HANDLER

;EHNDLR -- HANDLE ALL ERRORS
;THE ONLY CALL IS THRU THE ERROR. MACRO

EHNDLR:	CALL	SAVACS		;SAVE THE ACS
	TLNE	F,FL$OPN	;OUTPUT FILE OPEN?
	TRNN	DC,(DV.TTY)	;IS THIS TTY OUTPUT?
	 CAIA			;OUTPUT NOT OPEN OR NOT TTY OUTPUT
	 CALL	O$CRLF		;YES--MAKE NEW LINE SO MESSAGE IS SEEN
	CALL	FRCTYO		;FORCE OUTPUT IF TTY
	MOVE	P1,@0(P)	;GET FLAGS AND ADDRESSES
	AOSE	ERRTYX		;CLEAR/CHECK FLAG
	SKIPN	@.TYOCH##	;IS SCAN TTCALLING?
	 JRST	[SETZM	ERRTYX	;YES--CLEAR FLAG
		JRST	EHND.0]	;AND SKIP ON
	SETZ	T1,		;NO--SO MAKE IT
	CALL	.TYOCH##	;TELL SCAN
	MOVEM	T1,ERRTYX	;REMEMBER/SET FLAG
EHND.0:	MOVEI	T1,"?"		;ASSUME AN ERROR
	TLNE	P1,EF$WRN	;CHECK WARNING
	MOVEI	T1,"%"		;YES
	TLNE	P1,EF$INF	;IF BOTH OFF NOW THEN INFO
	MOVEI	T1,"["		;GOOD THING WE CHECKED
	CALL	.TCHAR##	;OUTPUT THE START OF MESSAGE
	MOVSI	T1,MY$PFX	;SET UP MY PREFIX
	HLR	T1,(P1)		;GET MESSAGE PREFIX
	CALL	.TSIXN##	;OUTPUT THE PREFIXES
	CALL	.TSPAC##	;AND A SPACE
	HRRZ	T1,(P1)		;GET STRING ADDRESS
	CALL	.TSTRG##	;SEND IT
	MOVE	T1,SAVAC+T1	;GET ORIGINAL T1 IN CASE TYPEOUT DESIRED
	LDB	T2,[POINT 5,P1,17] ;GET TYPED OUT DESIRED
	CAILE	T2,EF$MAX	;CHECK LEGAL
	 MOVEI	T2,0		;NOOOP
	CALL	@ERRTAB(T2)	;CALL THE ROUTINE
	TLNE	P1,EF$NCR	;IF NO CRLF THEN DON'T CLOSE INFO
	 JRST	EHND.1		;NO--DON'T CHECK
	MOVEI	T1,"]"		;PREPARE TO CLOSE INFO
	TLNE	P1,EF$INF	;CHECK FOR INFO
	CALL	.TCHAR##	;SEND INFO CLOSE
	TLNN	P1,EF$NCR	;NO CARRIAGE RETURN?
	CALL	.TCRLF##	;YES--SEND ONE
EHND.1:	SKIPN	T1,ERRTYX	;DID WE RESET SCAN?
	 JRST	EHND.2		;NO
	CALL	.TYOCH##	;AND RESTORE IT
	SETZM	ERRTYX		;CLEAR FLAG
EHND.2:	TLNE	P1,EF$FTL	;NOW CHECK FATAL
	 JRST	ERRFTL		;YES--GO DIE
	;FALL INTO RESACS
;RESACS -- RESTORE ALL ACS FROM SAVAC AREA
;	CALL	RESACS
;	*ACS RESTORED FROM SAVAC*

RESACS:	MOVEM	17,SAVAC+17
	MOVSI	17,SAVAC
	BLT	17,17		;REGISTERS ARE RESTORED
	POPJ	P,		;RETURN

ERRTAB:	$POPJ			;CODE 0 -- NO ACTION
	.TDECW##		;CODE 1 -- TYPE T1 IN DECIMAL
	.TOCTW##		;CODE 2 -- TYPE T1 IN OCTAL
	.TSIXN##		;CODE 3 -- TYPE T1 IN SIXBIT
	.TPPNW##		;CODE 4 -- TYPE T1 AS PPN
	.TSTRG##		;CODE 5 -- T1 POINTS TO ASCIZ STRING
	.TFBLK##		;CODE 6 -- T1 POINTS AT FDB

;HERE TO DIE--

ERRFTL:	RESET			;KILL ALL FILES
	MOVE	P,INIPDP	;RESET PDL
IFE FT$SEG,<CALL UPSCN>		;NEED HISEG
	CALL	.CLRBF##	;CLEAR REST OF LINE OR WHATEVER
	SKIPN	OFFSET		;CCL ENTRY
	 SKIPL	ISCNVL		;OR MIXLOD MONITOR COMMAND?
	  CALL	.MONRT##	;YES--EXIT 1,
	JRST	RESTRT		;AND RESTART ON CONTINUE

;SAVAC -- SAVE ALL ACS
;CALL -- PUSHJ P,SAVACS
;	*ACS SAVED IN SAVAC*	BEWARE!!

SAVACS:	MOVEM	17,SAVAC+17	;SAVE ONE
	MOVEI	17,SAVAC
	BLT	17,SAVAC+16
	MOVE	17,SAVAC+17
	POPJ	P,		;ACS ARE SAVED

;TYSLSH -- TYPE A SLASH THROUGH .TCHAR

TYSLSH:	MOVEI	T1,"/"
	PJRST	.TCHAR##	;DONE
SUBTTL	STORAGE

IFN FT$SEG,<RELOC 0>		;STORAGE GOES IN LOW SEGMENT

;STORAGE THAT REMAINS BETWEEN RUNS

U (ISCNVL)		;VALUE FROM .ISCAN
U (TLDVER)		;-1 WHEN TYPED VERSION TO TTY
IFE FT$SEG,<	;NEED TO STORE RUN ARGS
U (SAVRUN)		;-1 WHEN HAVE SAVED RUN ARGS
U (SGDEV)		;RUN UUO ARGUMENTS ARE SG???
U (SGNAM)
U (SGLOW)
U (SGPPN)
>;END IFE FT$SEG
U (OFFSET)		;STARTING OFFSET

FW$ZER==.	;FIRST WORD ZEROED
U (PDLIST,LN$PDL)	;PUSHDOWN LIST
U (SAVAC,20)		;SAVE ACS HERE
U (OPNBLK,3)		;OPEN BLOCK
U (LKPBLK,.RBTIM+1)	;LOOKUP/ENTER BLOCK
U (PTHBLK,^D9)		;PATH BLOCK
U (SVINOB,3)		;PLACE TO SAVE OPEN BLOCK FOR INPUT FILE
U (SVINLK,.RBTIM+1)	;PLACE TO SAVE LOOKUP BLOCK FOR INPUT FILE
U (CHRKNT)		;COUNTER FOR CHARACTERS OUTPUT
U (ERRTYX)		;FLAG FOR EHNDLR
U (ACTLST,LN$ACT)	;ACTION LIST
U (SCMDBP)		;BYTE PTR TO STORE IN CMDBFR
U (SCMDCT)		;BYTE CTR TO STORE IN CMDBFR
IFN FT$WLD,<	;WILD STORAGE
U (WLDFIR)		;ADDRESS OF SCAN BLOCK FOR .LKWLD
U (WLDPTR)		;WILD STORES SCAN BLOCK ADDR HERE
U (LKWLFL)		;-1/0/1 == DISK/DECTAPE/OTHER OR NULL
>;END IFN FT$WLD
U (EBCKNT)		;COUNT-DOWN FOR EBCDIC PRETTY PRINTING
U (IFILSZ)		;SIZE OF INPUT FILE IN BLOCKS
U (IDVNAM)		;INPUT REAL DEVICE NAME
U (ODVNAM)		;OUTPUT REAL DEVICE NAME
U (IBHR,3)		;INPUT BUFFER HEADER
U (OBHR,3)		;OUTPUT BUFFER HEADER
U (FORADR)		;ADDRESS OF BUFFER FOR FORTRAN/IREAD INPUT
U (BYTPTR)		;PTR FOR /MODE:BYTE
U (BYTBPW)		;# BYTES/WORD
U (BYTREM)		;# BITS LEFT OVER
U (BYTDPB)		;# DIGITS/BYTE
U (BYTWID)		;BYTE WIDTH FOR A WORD
U (BYTBPL)		;# BYTES/LINE
U (BYTRDB)		;REMAINDER DIGITS/BYTE
RUN$FZ==.	;FIRST WORD ZEROED AT COMMAND PROCESS START
BLOCK	3		;***FOR TAPOP. UUO
REELID==.-1		;REELID IS TAPOPBL-1
TAPOBL:			;FOR TAPOP.
U (FILE)		;FILE NUMBER
U (RECORD)		;RECORD NUMBER
U (TOTFIL)		;TOTAL FILES DUMPED
U (TOTREC)		;TOTAL RECORDS DUMPED
U (WRDCNT)		;ACCUMULATED RECORD WORD COUNT
U (ONLYLO)		;LOWEST WORD # IN RECORD TO DUMP
U (ONLYHI)		;HIGHEST WORD # IN RECORD TO DUMP
RUN$LZ==.-1	;LAST WORD ZEROED AS RUN STARTS (DUMPING)

SCN$FZ==.	;FIRST WORD ZEROED AT CLRANS
U (CMDBFR,LN$CMD)	;SAVE COMMAND HERE SO WE CAN PUT ON DUMP
U (INPSPC,.FXLEN)	;INPUT SPECIFICATION
U (OUTSPC,.FXLEN)	;OUTPUT SPECIFICATION
U (DUMPFL)		;-1 WHEN /DUMP SEEN
U (TITLEB,LN$TTL)	;BLOCK FOR /TITLE
 TITLEE==.-1	;FOR END OF BLT
U (TTLZER)		;ENSURE A ZERO ON THE END
SCN$LZ==.-1	;LAST WORD ZEROED AT CLRANS
SCN$FO==.	;FIRST WORD MINUS ONNED AT CLRANS
U (S.BLKF)		;/BLOCK:N
U (BUFSIZ)		;/BUFSIZ
U (FLERR)		;/ERROR:ARG
U (LINRDX)		;/LINRDX
U (NMTBUF)		;/MTBUF
U (FLNTRY)		;/NORETRY
U (FLOMIT)		;/OMIT
U (USERDX)		;/RADIX
U (USRWID)		;WIDTH OF WORD IF /RADIX USED
U (FLWIDT)		;/WIDTH
SCN$LO==.-1	;LAST WORD ONNED AT CLRANS
LW$ZER==.-1	;LAST WORD ZEROED AT STARTUP
IFN FT$SEG,<	;FORCE LITERALS OUT IN HIGH SEGMENT
	RELOC
>;END IFN FT$SEG
	XLIST	;JUST LITERALS FOLLOWING
	LIT
	LIST	;LITERALS PRECEDE
ENDUMP::END	DUMPR