.TITLE	LIST	;MULTI-COLUMN LISTER
;	CHANGE THE VERSON NUMBER!
	.SBTTL	DEFINITIONS
	.IDENT /860113/	;MODIFIED BY GCE
;TO OMIT FORM FEED ON FIRST .OPEN, REMOVE ";" IN NEXT LINE
;	NOFF1=0
;THIS VERSION TABS 8 COLUMNS AND ALLOWS LINE TRUNCATION BY "/TR"
;HEADER CAN BE OMITTED BY /NH SWITCH
R0=%0
R1=%1
R2=%2
R3=%3
R4=%4
R5=%5
SP=%6
PC=%7

SPACE=40
XCR=15
XLF=12
XFF=14

;THE FOLLOWING TWO SYMBOLS ARE ONLY USED TO SET BUFFER SIZES.
;THEY REPRESENT THE MAXIMUM PAGE SIZE
;FOR WHICH THE PROGRAM WILL WORK WITHOUT ERROR. THE OUTPUT PAGE
;SIZE MAY BE LESS THAN OR EQUAL TO THE SIZE SPECIFIED.
MAXWID=240.	;MAXIMUM # PRINTABLE CHARACTERS IN OUTPUT LINE
		;I.E., NOT COUNTING TRAILING CR, LF
MAXLIN=88.	;MAXIMUM # LINES ON A PAGE

	.MCALL	CSI$,FSRSZ$,GCMLB$,GCMLD$;RSX11D MACROS
	.MCALL	CSI$1,CSI$2,RCML$,GCML$,OPEN$R,OPEN$W
	.MCALL	CLOSE$,GET$,PUT$
	.MCALL	FDBDF$,FDAT$A,FDRC$A,FDOP$A;FDB MACROS
	CSI$
	.PSECT	ZPDTR,RW
CSBLK:	.BLKB	C.SIZE
	.EVEN
	.word	0,0,0,0
	FSRSZ$	5.	;3 FILES AT A TIME MAX
; FOLLOWING MEANS ASSIGN TI: TO 1 BY TKB.
	.WORD	0,0,0,0
	GCMLD$	;DEFINE OFFSETS
CMD:	GCMLB$	2,LST,WRKBUF,3,PDLL,258.
; LUN 1, BIIIIG INPUT BUFFER (ALLOWS LOTS OF SCREWING AROUND...)
; LUN 3 IS TERMINAL NOW...
	.EVEN
	.WORD	0,0,0,0
PDLL:	.BLKB	G.LPDL
	.EVEN
	.WORD	0,0,0,0
	.WORD	0,0,0,0
	.BLKW	256.
;
	.MACRO	WRITE	LINK,BUFF,?LBL
; FAKE DOS-11 WRITE CALL WITH BUFFER HDR AND LINKBLOCK
	MOV	BUFF,-(SP)	;STACK LINE BUFFER ADR
	MOV	LINK,-(SP)	;STACK LINK BLOCK ADR
	BIT	#SW.RL,SWITCH	;WANT CONSTANT LENGTH RECORDS?
	BEQ	LBL		; NO
	JSR	PC,COPYRL	; YES, PAD BUFFER
LBL:	JSR	PC,RSXWRT	;WRITE VIA RSX
	CMP	(SP)+,(SP)+	;CLEAN STACK
	DECB	ROLL		;COUNT LINE
	.ENDM
;

;RSX11D WRITING SUBROUTINE, CALLED AS FOR A DOS WRITE.
;DECODES COMAND AND FIXES BUFFER HEADER A LA DOS.
;N.B.--TREATS A READ OF A ZERO LENGTH RECORD AS A FLAG
;THAT ENDFILE HAS BEEN SEEN, FOR LACK OF A BETTER WAY TO
;DO IT.
LSTPP:	.ASCII	/LST>/
	.PSECT	RCODE,RO
RSXWRT:
	MOV	R0,-(SP)
	CLR	-(SP)		;FIND SOME MORE WORK SPACE
	MOV	10(SP),R0	;BUFFER HDR ADDR OF CALL
	MOV	4(R0),@SP	;SIZE OF BUFFER (NEEDED FOR OUTPUT)
	SUB	#2,@SP		;NO CRLF OUT.
	ADD	#6,10(SP)	;POINT PAST HEADER TO DATA OR TO
				;POINTER TO DATA
DUMP=4				;DOS DUMP MODE BIT
	BIT	#DUMP,2(R0)	;IS IT DUMP MODE?
	BEQ	1$		;NO, 10(SP) IS DATA ADDR
	MOV	@10(SP),10(SP)	;YES, GET DATA ADDR NOW
1$:	PUT$	6(SP),10(SP),(SP),ERR1	;WRITE THE DATA
	TST	(SP)+		;RESTORE STACK
	MOV	(SP)+,R0	;AND CALL R0
	RTS	PC		;(THO' NOT COND CODES)
;
;RSXRED--READ A BUFFER WITH FDB ON STACK INSTEAD OF DOS LINK
;OTHERWISE USES DOS BUFFER HEADER JUNK 
; SETS CORRECT DOS BITS.
RSXRED:	MOV	R0,-(SP);	;GET A REG TO USE
	CLR	-(SP)		;AND A CELL ON STACK
	MOV	10(SP),R0	;CALL BUFFER HDR
	BICB	#100,3(R0)	;CLEAR EOF INDICATOR
	MOV	@R0,@SP		;ADDR OF MAX SIZE
	ADD	#6,10(SP)	;POINTER DATA OR ADDR OF DATA
	BIT	#DUMP,2(R0)	;TEST DUMP MODE (ADDRESS OF BUFFER
				; FOLLOWS HDR BLK IN DUMP MODE. BUFFER
				; FOLLOWS HDR DIRECTLY IF NOT.)
	BEQ	1$		;NOT DUMP MODE; 10(SP) IS DATA ADDR
	MOV	@10(SP),10(SP)	;DUMP MODE. GET DATA ADDR TO STACK
1$:	MOV	R0,-(SP)	;NEED R0 AFTER READ SO SAVE IT
				;IN CASE GET$ SCREWS IT UP.
	GET$	10(SP),12(SP),2(SP)
	BCC	3$		;CHECK EOF
	CMPB	#IE.EOF,F.ERR(R0)	;SEE IF EOF
	BNE	3$		;IF NOT, IGNORE ERR
	MOV	@SP,R0		;ELSE RETRIEVE POINTER
	BISB	#100,3(R0)	;AND SET THE END-OF-FILE BIT
3$:
	MOV	(SP)+,R0	;RESTORE BUFHDR POINTER
	MOV	6(SP),-(SP)	;FDB POINTER
	ADD	#F.NRBD,@SP	;ADDR OF BYTE COUNT READ
	MOV	@0(SP),@SP	;GET # BYTES READ
	MOV	@SP,4(R0)	;SAVE IN BUFFER HDER
	MOV	(SP)+,(SP)	;GET ADDR OF END
	ADD	10(SP),(SP)	;OF DATA
	MOV	R5,-(SP)	;USE R5 A SEC...
	MOV	10(SP),R5	;FDB ADDR
	BITB	#3,F.RATT(R5)	;SEE IF INTERNAL C.C. FILE (AS PIP DIRECTORY)
	BNE	11$		;NO, SO OUR TERMINATORS OUGHT TO BE OK.
;IF INTERNAL CARRIAGE CONTROL HAS LEADING CRLF, MAKE IT NULLS. REST OF LST
;EXPECTS TRAILING TERMINATORS, NOT LEADING ONES...
	MOV	12(SP),R5	;START OF DATA ADDRESS
	CMPB	(R5),#16	;TERMINATOR?
	BHIS	2$		;NO
	CMPB	@R5,#11		;TAB AND LOWER STAY OK
	BLOS	2$
	CLRB	@R5		;YES, NULL IT.
2$:	INC	R5
	CMPB	(R5),#16	;CHECK 2ND CHAR AS TERMINATOR TOO
	BHIS	11$
	CMPB	@R5,#11		;TEST BELOW AND ABOVE
	BLOS	11$
	CLRB	@R5		;IF TERMINATOR MAKE IT NULL
11$:
;IF SKIPPING LETTERS ON INPUT, NULL OUT N CHARS AT START OF LINE.
	BIT	#SW.SL,SWITCH	;SKIPPING CHARS ON INPUT?
	BEQ	21$		;NO, NO ACTION
	MOV	R5,-(SP)	;SAVE R4,R5
	MOV	R4,-(SP)
	MOV	SKPLTR,R5	;CHARS TO SKIP
	BGT	22$
	CLR	R5		;DEFAULT TO 0 IF NEGATIVE
22$:	CMP	R5,4(R0)	;DON'T NULL MORE THAN WE READ
	BLO	23$		;IF OK, BRANCH
	MOV	4(R0),R5	;R5 HAS # TO NULL (FLUSHED ON OUTPUT)
23$:	MOV	16(SP),R4	;ADDR OF START OF DATA
24$:	CLRB	(R4)+		;NULL A BYTE
	DEC	R5
	BGT	24$		;DO ALL THAT WHICH WAS ASKED
	MOV	(SP)+,R4	;RESTORE R4,R5
	MOV	(SP)+,R5	;
21$:
	.IF	NDF,M..RS
	BIT	#SW.RI,SWITC2	;RIGHT SHIFTING DATA?
	BEQ	120$		;IF EQ NO, SKIP
	MOV	R5,-(SP)
	MOV	R4,-(SP)
	MOV	16(SP),R4	;ADDR OF START OF DATA
;R0 = BUFFER HEADER STILL.
;4(R0)= # CHARS READ IN
	MOV	R1,-(SP)
	MOV	R2,-(SP)	;NEED SOME MORE REGS
	MOV	R3,-(SP)
	MOV	RIVAL,R1	;NO. TO SHIFT RIGHT BY
	BIC	#^C37,R1	;MASK TO 0-31 SPACES
	MOV	R4,R5
	ADD	4(R0),R5	;R5 = ADDR OF END OF DATA + 1
	MOV	R5,R2		;COPY TO R2
	ADD	R1,R5		;POINT R5 PAST OLD END
	MOV	4(R0),R3	;GET SIZE AGAIN
;	DEC	R3
	BLE	118$
119$:	MOVB	-(R2),-(R5)	;COPY STRING UP
	DEC	R3
	BGT	119$		;FOR ALL WE GOT
118$:	ADD	R1,4(R0)	;ADD IN THE NEW SIZE SEEN
	ADD	R1,14(SP)	;ADD SIZE ON STACK TOO
117$:	MOVB	#40,(R4)+	;FILL SPACES INTO FRONT OF RECORD
	DEC	R1
	BGT	117$
	MOV	(SP)+,R3
	MOV	(SP)+,R2
	MOV	(SP)+,R1
	MOV	(SP)+,R4
	MOV	(SP)+,R5
120$:
	.ENDC
	MOV	(SP)+,R5	;RESTORE R5
;	ADD CODE TO PERMIT /MS COMPRESS SPACES SWITCH (NULL ALL BUT 1ST OF
;	MULTIPLE SPACES
	BIT	#SW.NS,SWITC2	;NO SPACES READIN?
	BNE	334$		;IF SO ENTER THIS CODE
	BIT	#SW.MS,SWITCH	;NULLING MULTIPLE SPACES?
	BEQ	30$		;NO, BRANCH
334$:	MOV	R5,-(SP)
	MOV	R4,-(SP)	;YES, SAVE A FEW REGS TO USE HERE
	MOV	R2,-(SP)
	MOV	R3,-(SP)
	MOV	4(R0),R3	;GET # CHARS WE READ IN
	MOV	20(SP),R4	;AND ADDRESS OF START OF LINE READ
	CLR	R5		;LAST CHARACTER READ STORAGE HERE...
32$:	MOVB	(R4)+,R2	;GET A CHARACTER
	CMPB	R2,#40		;A SPACE?
	BNE	33$		;NO
	BIT	#SW.NS,SWITC2	;NO SPACES AT ALL TO BE TREATED ON INPUT?
	BNE	335$		;IF SO NULL ANYWAY REGARDLESS OF WHAT LAST WAS
	CMPB	R5,#40		;WAS LAST A SPACE?
	BNE	33$		;NO, SAVE LAST AND GET NEXT CHARACTER
;	LAST CHARACTER WAS A SPACE AND SO IS THIS ONE...NULL THIS ONE
335$:	CLRB	-1(R4)		;NULL SECOND AND LATER SPACES...
33$:	MOV	R2,R5		;SAVE LAST CHARACTER SEEN
	DEC	R3		;COUNT DOWN TILL END
	BGT	32$		;DONE WHEN NO MORE CHARS LEFT
31$:	MOV	(SP)+,R3	;GET BACK REGS
	MOV	(SP)+,R2
	MOV	(SP)+,R4
	MOV	(SP)+,R5
30$:
	MOVB	#15,@0(SP)	;PUT IN CRLF
	INC	@SP
	MOVB	#12,@(SP)+
	ADD	#4,4(R0)	;ADJUST # BYTES READ COUNTER
	MOV	(SP)+,R0
	RTS	PC

	.PSECT	RWDATA,RW
	.MCALL	FDOF$L,FCSBT$,FDBDF$,FDRC$A,FDAT$A,NMBLK$
	.MCALL	CSI$1,CSI$2,OPEN$R,OPEN$W
	.MCALL	CSI$SW,CSI$ND,CSI$SV
FDOF$L	;LOCAL OFFSET DEFS
FCSBT$	;DEFINE BIT NAMES
KBIFDB:	FDBDF$	;KB INPUT FDB
	FDRC$A	,BUF,MAXWID	;
DTIFDB:	FDBDF$			;DATA INPUT FDB
	FDRC$A	,BUF,MAXWID	;DATA ADDR
DTOFDB:	FDBDF$			;DATA OUTPUT FDB
	FDRC$A	,BUFA,MAXWID	;BUFFER
	FDAT$A	R.VAR,,MAXWID	;FILE CHARACTERISTICS
.MCALL	NBOF$L
NBOF$L	;LOCALLY DEFINED NAMEBLK OFSETS
KBIFNB:	NMBLK$	KBICMD,LST,,TI,0
DTIFNB:	NMBLK$	DATA,TMP,,SY,0
DTOFNB:	NMBLK$	DATA,LST,,SY,0	;DEFAULT FILENAME BLOCKS
	.word	0,0	;slop
WRKBUF:	.BLKB	258.
	.WORD	0,0	;EXTRA SLOP AT END
	.SBTTL	COMMAND STRING PROCESSING
	.MCALL	FINIT$
SPSAV:	.WORD	0	;STACK POINTER SAVE
	.PSECT	RCODE,RO
LIST:			;INIT & OPEN
	MOV	SP,SPSAV
	FINIT$
TRY:				;PROMPT HERE ANG GET COMMAND LINE
	MOV	SPSAV,SP	;RESET SP (QUICK; DIRTY)
;	FINIT$
	CLR	SWITC2
	CLR	SWITCH	;RESET SWITCHES TO DEFAULTS
;	ADD RUNTIME FDB INITIALISE ROUTINES
	.MCALL	FDAT$R,FDRC$R,FDOP$R,FDBF$R
	FDAT$R	#DTIFDB,#R.VAR,#FD.CR,#MAXWID,#-2,#-5
	FDAT$R	#DTOFDB,#R.VAR,#FD.CR,#MAXWID+4,#-2,#-5
	FDRC$R	#DTIFDB,,#BUF,#MAXWID+4
	FDRC$R	#DTOFDB,,#BUF,#MAXWID+4

	CLR	OSMSK		;NO OUTPUT SWITCH DEFAULTS
	MOV	#1,SPCNT		;DEFAULT 1 SPOOLED COPY
	CLR	CMAX	;TO 0 COL
	CLR	ROLL0
	CLR	PADW
	MOVB	#'!,SEPCHR	;SEPARATOR CHARACTER IS INITIALLY "!"
;LEAVE PAGE SIZES ALONE
	GCML$	#CMD,#LSTPP,#4	;USE RSX FACILITY
	BCC	47$
	RCML$	#CMD
	.MCALL	EXIT$S
	EXIT$S		;LEAVE WHEN SEE EOF
47$:
	TSTB	CMD+G.ERR	;SEE IF ERROR ON READ
	BPL	48$
	EXIT$S			;EXIT TASK ON I/O ERR IN CMD
48$:
	.IF DF	NOFF1		;OMIT FF ON OUTPUT
	MOVB	#1,OPENLP	;DEVICE OPEN
	.ENDC			;AS OPEN WILL DO IT
;	ISSUE CSI COMMANDS AND OPEN FILES HERE.
;(LOSE IF FILES DON'T EXIST!)
	MOV	#EHTXT,R0
	MOV	#40.,R1
441$:	CLR	(R0)+
	SOB	R1,441$		;ZERO 2ND HDR BUFFER
	MOV	#CMD+G.CMLD,R0	;LEN, ADDR OF STRING READ IN
	MOV	@R0,R1	;LENGTH
	MOV	2(R0),R2	;ADDR
	CSI$1	#CSBLK,R2,R1	;COMPRESS OUT SPACES, TABS, ETC.
;NOW PROCESS I/O SPECIFICATIONS.
;NO WILD-CARDS HERE!
DTIDSP=C.DSDS+CSBLK
DTODSP=DTIDSP
;NOW GET INPUT SPECS AND SWITCHES
;
	CSI$2	#CSBLK,INPUT,#SWTBL
	.SBTTL	    PROCESS (INPUT) SWITCHES
DTODSP=DTIDSP
	MOV	#DTIFDB,R0
	MOV	R0,R1
	MOV	R0,R2
	MOV	#DTIFNB,R3	;SET UP FOR .PARSE
	ADD	#F.DSPT,R2
	ADD	#F.FNB,R1
	JSR	PC,.PARSE			;FILL IN DEFAULTS
	OPEN$R	#DTIFDB,#3,#DTIDSP,,#BUF,#MAXWID,ERR1;OPEN INPUT LU3
	TST	(R3)+		;PTR TO NEXT # WORDS TO FOLLOW
	CSI$2	#CSBLK,OUTPUT,#OUTCSW	;GET OUTPUT FIRST
DTIDSP=C.DSDS+CSBLK
DTODSP=DTIDSP
	MOV	#DTOFDB,R0
	MOV	R0,R1
	MOV	R0,R2
	MOV	#DTOFNB,R3	;SET UP FOR .PARSE
	ADD	#F.DSPT,R2
	ADD	#F.FNB,R1
	JSR	PC,.PARSE			;FILL IN DEFAULTS
	.MCALL OPEN$A
	BIT	#1,OSMSK	;/AP OUTPUT SWITCH?
	BEQ	10$		;NO
	OPEN$A	#DTOFDB,#4,#DTODSP,,#BUFA,#MAXWID,SCRAM ;OPEN FOR APPEND
	BR	20$
10$:
	OPEN$W	#DTOFDB,#4,#DTODSP,,#BUFA,#MAXWID,SCRAM	;OUT LU4
20$:
	.PAGE
	.SBTTL	    CHECK LIMITS

	;SET UP VALUES FROM WHATEVER WAS ENTERED
	MOV	LINSIZ,SW.WID
	MOV	CMAX,SW.COL
	MOV	PAGSIZ,SW.LEN
	MOV	ROLL0,SW.ROL
	MOV	PADW,SW.RLN
	.IF	NDF,SW$ALL
	BITB	#FD.TTY,DTOFDB+F.RCTL	;IS OUTPUT A TERMINAL?
	BEQ	25$		;IF NOT BRANCH
;FOR TERMINALS SET UP /WI:80./LE:22. DEFAULT IF NO SWITCHES.
	BIT	#SW.WI,SWITCH	;WAS SWITCH /WI:NNN GIVEN?
	BNE	26$		;YES, USE IT.
	MOV	#80.,SW.WID	;NO, DEFAULT
	MOV	#80.,LINSIZ
26$:
	BIT	#SW.LE,SWITCH	;WAS LENGTH SWITCH GIVEN?
	BNE	27$		;YES, USE IT
	CMP	#132.,SW.WID	;132 WIDE LOOKS LIKE LA36 SO SET USUAL LENGTH
	BEQ	25$		;AND LET ALONE.
	MOV	#21.,SW.LEN
	MOV	#21.,PAGSIZ	;NO, DFAULT TO 22
27$:	BIT	#SW.ED,SWITCH	;REVERSE SENSE OF /ED SWITCH TOO
	BEQ	28$		;IF OFF TURN ON
	BIC	#SW.ED,SWITCH	;IF ON TURN OFF AND IGNORE
	BR	25$
28$:	BIS	#SW.ED,SWITCH	;SO WE DON'T GET FF TO TERMINAL UNLES /ED
	CLRB	EDVAL		;ALSO ARRANGE OUTPUT OF NULL FIRST
25$:
	.ENDC
INTERP:	JSR	R5,LIMITS	;PROCESS VALUE
	  .WORD	SW.WID,SW.WI,MAXWID,MINWID,LINSIZ
	JSR	R5,LIMITS	;PROCESS VALUE
	  .WORD	SW.LEN,SW.LE,MAXLIN,2.,PAGSIZ
	JSR	R5,LIMITS	;PROCESS VALUE
	  .WORD	SW.COL,SW.CO,18.,0,CMAX
	JSR	R5,LIMITS	;PROCESS VALUE
	  .WORD	SW.ROL,SW.RO,MAXLIN,5.,ROLL0
	JSR	R5,LIMITS	;PROCESS VALUE
	  .WORD	SW.RLN,SW.RL,MAXWID,MINWID,PADW

	.SBTTL	    CORRECT PAGE SIZE FOR HEADER, ETC

	MOVB	PAGSIZ,LMAX	;PAGE SIZE WITH HEADER
	DECB	LMAX		;1 LINE FOR FF
	BIT	#SW.NH,SWITCH	;OMIT HEADER?
	BNE	1$		; YES
	DECB	LMAX		; NO, BLANK LINE IN HEADER
1$:	BIT	#SW.NP,SWITCH	;NO PAGINATION AT ALL?
	BEQ	51$		;NO, LEAVE ALONE
	INCB	LMAX		;YES, PAGINATION OMITTED. ADJUST!
51$:
	.SBTTL	    COMPUTE COLUMN WIDTHS

	MOV	#1,R4		;COL #
	CLR	R2
	BISB	LINSIZ,R2	;LINE LENGTH
	MOV	#WIDTH,R3	;ADR FOR COL 1
2$:	MOV	R4,SDIV1	;GET MAX WIDTH
	MOV	R2,DDIV1
	CLR	DDIV2
	JSR	R5,IDIV
	MOV	DDIV1,R0
	MOV	DDIV2,R1	;GET RESULT
	MOVB	R0,(R3)+	;SAVE IT
	INC	R4		;ANOTHER COL PER PAGE
	SUB	#2,R2		;2 CHAR PER DIVIDER
	CMP	#19.,R4		;DONE ALL? (TABLE ALLOWS UP TO 20.)
	BHIS	2$		; NO, DO NEXT

	.SBTTL	    PROCESS FORM FEED

	MOVB	#XFF,FORM+6	;ASSUME FF
	BIT	#SW.ED,SWITCH	;WANT ^D?
	BEQ	3$		; NO
	MOVB	EDVAL,FORM+6	;YES, FILL IN WITH SEPARATOR CHAR.
;NOTE THAT /ED:NNN TAKES A VALUE NOW AND SAVES IN EDVAL. OCTAL.
;DEFAULT IS 4.
;	OLD CODE:
;	MOVB	#4,FORM+6	; YES, ^D
3$:
	.SBTTL	DATA FILE PROCESSING
	.SBTTL	    CREATE LIST HEADER

	MOV	#DASH,R3	;HEADER BUFFER ADR
	MOV	R3,R0		;GET COPY
	MOVB	LINSIZ,R2	;LINE LENGTH
FILL:	MOVB	#'-,(R0)+	;DASHES TO HEADER
	DECB	R2
	BNE	FILL
	MOV	R3,R0		;BACK AT LEFT
	MOV	#VERSON,R1	;VERSION # AT LEFT
	MOV	#VERLEN,R2
FILLV:	MOVB	(R1)+,(R0)+	;VERSION TO HEADER
	DEC	R2
	BGT	FILLV
	MOVB	#SPACE,(R0)+

	BISB	LINSIZ,R2	;RIGHT SIDE
	ADD	#2,R2		;COUNT CR LF
	MOV	R2,HEADER+4	;ACTUAL BYTE COUNT
	ADD	R3,R2		;PT TO END+1
	MOV	#TALSIZ,R0	;SIZE OF RIGHT INFO
	MOV	#TAIL,R1	;RIGHT SIDE INFO
1$:	MOVB	-(R1),-(R2)	;COPY RIGHT SIDE
	DEC	R0
	BGT	1$
	INC	R2		;LOCATION FOR DATE
	JSR	PC,RSAV
	MOV	#Z22$,R5	;OUTPUT ADDR
	JSR	PC,CVTDT	;CONVERT DATE TO ASCII
	JSR	PC,RRES		;POP REGS AGAIN
	MOV	R0,-(SP)
	MOV	R1,-(SP)
	MOV	R2,-(SP)
	MOV	#9.,R0
	MOV	#Z22$,R1
23$:	MOVB	(R1)+,(R2)+
	DEC	R0
	BNE	23$	;COPY TEXT
	BR	Z24$
	.PSECT	RWDATA,RW
Z22$:	.ASCII	/04-JUL-76/;DUMMY DATE FOR NOW
	.EVEN
	.PSECT	RCODE,RO
Z24$:	MOV	(SP)+,R2
	MOV	(SP)+,R1
	MOV	(SP)+,R0	;RESTORE REGS USED
	ADD	#20,R2		;FOR PAGE # (TENS)
	MOV	R2,PAGEAD	;SAVE IT

	BISB	WIDTH+1,R0	;CENTER-1
	SUB	#7,R0		;START OF NAME
	ADD	#DASH,R0	;PTR TO IT
	MOV	R0,-(SP)	;FILL IN DUMMY NAME TOO FOR STARTERS
	MOV	R1,-(SP)
	MOV	R2,-(SP)
	;PUT IN FILENAME FROM FILENAME BLK
	MOV	#DTIFDB,R1	;FDB
	ADD	#F.FNB,R1	;OFFSET TO FNB
	MOV	R1,-(SP)	;SAVE
	ADD	#N.FNAM,R1	;6 BYTES OF NAME
	MOV	#Z32$,R2
	MOV	R0,-(SP)
	MOV	(R1)+,R0
	JSR	PC,RADUP
	ADD	#3,R2
	MOV	(R1)+,R0
	JSR	PC,RADUP
	ADD	#3,R2	;GET LAST 3 CHARS OF NAME
	MOV	(R1)+,R0	;RAD50
	JSR	PC,RADUP	;CONVERT TO ASCII
	MOV	(SP)+,R0
	MOV	(SP)+,R1
	ADD	#N.FTYP,R1
	ADD	#4,R2
	MOV	R0,-(SP)
	MOV	@R1,R0
	JSR	PC,RADUP
	MOV	(SP)+,R0
	MOV	#13.,R2		;FILNAM.EXT
	MOV	#Z32$,R1		;DUMMY NAME
33$:	MOVB	(R1)+,(R0)+
	DEC	R2
	BNE	33$
	BR	Z34$
	.PSECT	RWDATA,RW
Z32$:	.ASCII	/FILNAME  .EXT/
	.EVEN
	.PSECT	RCODE,RO
Z34$:	MOV	(SP)+,R2
	MOV	(SP)+,R1
	MOV	(SP)+,R0
	ADD	#6,R0
	ADD	#4,R0
	.SBTTL	    PROCESS AN INPUT PAGE
	.SBTTL	        INITIALIZE

ZOTGO:	CLR	PAGEN		;LAST PAGE #
	MOV	#2,R2		;CONSTANT
	CLRB	EOD		;MORE IN FILE
	CLR	OVRFLO		;NO COLUMN OVERFLOW
	CLRB	VAR		;ASSUME # COLS SPECIFIED
	DECB	CMAX		;MAP 1-10. TO 0-9
	MOVB	CMAX,R0		;GET FOR INDEX
	BGE	1$		;# SPECIFIED
	INCB	VAR		;VARIABLE # COLS
	MOVB	#18.,CMAX	;MAXIMUM OF 18. COLS
	CLR	R0		;USE SINGLE COL MAX
1$:	MOVB	WIDTH(R0),WIDE	;WIDTH BEFORE TRUNCATION

	.SBTTL	        NEXT PAGE

NEWPAG:	MOVB	WIDTH,AVAIL	;FOR VARIABLE # COLS
	CLRB	AVAIL+1
	MOV	#L,PL		;FIRST LINE IN
	MOV	#C,PCO		; FIRST COL
	MOV	#BLOCK,R4	;SET PAGE BUFFER PTR
	CLRB	COL		;TO COUNT COLS

	.SBTTL	            NEXT COLUMN

NEWCOL:	CLRB	LINE		;TO COUNT UP # LINES ON PAGE
	MOV	R4,@PL		;SAVE PTR TO COLUMN HEAD
	CLRB	MAX		;LONGEST LINE FOR VAR # COLS

	.SBTTL	                NEXT LINE

NEWLIN:	JSR	PC,READL	;GET NEXT LINE
	CMPB	R3,MAX		;THIS LONGEST IN COL?
	BLOS	4$		; NO
	MOVB	R3,MAX		;SET NEW MAX
	TSTB	VAR		;VARIABLE # COLS?
	BEQ	4$		; NO, SKIP FOLLOWING JUNK

	.PAGE
	CMPB	R3,AVAIL	;STILL FIT ON PAGE?
	BLOS	4$		; YES
	MOV	@PL,PP		;SAVE COL HEAD FOR NEXT PAGE
	JSR	PC,PRINT	;PRINT PAGE
				;SET NEW PAGE VARIABLES
	CLRB	COL		;NO COLS ON NEW PAGE
	MOV	#L,PL		;SET PL TO FIRST COL
	MOV	#C,PCO		;RESET COLUMN INDEX
	MOV	#BLOCK,R4	;SET PTR TO PAGE BUFFER
	MOV	R4,L		;SET PTR TO FIRST COL ALSO
	MOVB	WIDTH,AVAIL	;# CHAR POSITIONS LEFT
	CLRB	AVAIL+1

				;COPY EXTRA LINES TO BUFFER TOP	
	MOVB	LINE,R5		;# LINES ON PAGE
	INC	R5
	MOV	PP,R1		;PTR TO FIRST LINE IN BUFFER
1$:	MOVB	(R1)+,R3	;GET LINE CHARACTER COUNT
	MOVB	R3,(R4)+	; & COPY IT
	BEQ	3$		;SKIP IF EMPTY LINE
2$:	MOVB	(R1)+,(R4)+	;COPY LINE
	DECB	R3
	BNE	2$		;0 TO 256, NOT -128 TO 127
3$:	DECB	R5		;ONE LESS LINE
	BGT	1$		;COPY REST OF LINES

4$:	INCB	LINE		;ANOTHER LINE ON PAGE
	CMPB	LINE,LMAX	;MORE FIT?
	BLT	NEWLIN		; YES

	CLR	R0
	BISB	MAX,R0		;LONGEST LENGTH IN COL
	MOVB	R0,@PCO		;SAVE IT
	INC	PCO		;MOVE PTRS TO NEXT COL
	ADD	R2,PL		; FOR NEXT TIME
	INCB	COL		;ONE LESS COLUMN
	CMPB	COL,CMAX	;MORE COLS ON PAGE?
	BGT	5$		; NO, PAGE FULL
	ADD	R2,R0		;# CHARS REQUIRED TO LIST COL
	SUB	R0,AVAIL	;# CHARS LEFT ON PAGE
	BGT	6$		;PAGE FULL
	.PAGE

	.SBTTL	    OUTPUT A PAGE

5$:	JSR	PC,PRINT	;PRINT FULL PAGE
	TSTB	EOD		;MORE?
	BEQ	NEWPAG		; YES
	BR	DONE

6$:	TSTB	EOD		;MORE?
	BEQ	NEWCOL		; YES
	JSR	PC,PRINT	;PRINT FULL PAGE
	BR	DONE


ERTXT:	.ASCII /LST--ERROR IN FILE PROCESSING/
ERSIZ=.-ERTXT
	.EVEN
ERR1:	NOP
ERR2:	NOP
	.MCALL	QIOW$S
	QIOW$S	#IO.WVB,#5,#5,,,,<#ERTXT,#ERSIZ,#40>
	TST	(SP)+	;JUNK CALL VIA JSR PC.
	.SBTTL	COMPLETION PROCESSING
	.SBTTL	    CLOSE INPUT FILE
DONE:	CLOSE$	#DTIFDB,SCRAM		;CLOSE & RELEASE
	BCS	SCRAM		;CAN'T CLOSE--EXIT.

	.SBTTL	    CLOSE OUTPUT FILE

	.MCALL	PRINT$
	BIT	#2,OSMSK	;DID HE WANT THE FILE SPOOLED (/SP:N)?
	BEQ	11$		;NO, JUST CLOSE IT.
	BIC	#-40,SPCNT	;MAKE COPIES RANGE LEGAL (< 32)
	BNE	10$		;IF NONZERO ALL IS WELL
	MOV	#1,SPCNT	;IF ZERO MAKE IT 1
10$:
	PRINT$	#DTOFDB,SCRAM,,,,,,SPCNT ;QUEUE SPCNT COPIES OUT
	BR	20$		;THEN GO (SPOOL CALL CLOSES FILE)
11$:
	CLOSE$	#DTOFDB,SCRAM	;CLOSE & RELEASE
20$:
	BCS	SCRAM		;IF CLOSE FAILS, LEAVE
	.IF	NDF,ONCEO.
	JMP TRY
	.ENDC
SCRAM:	EXIT$S	;LEAVE. LIST DOESN'T RE-INITIALIZE CORRECTLY.

	.SBTTL	SUBROUTINES
	.SBTTL	    LIMITS: CHECK ON SWITCH VALUES
;	JSR	R5,LIMITS
;	 .WORD	ADR OF VALUE ENTERED (IN SWITCH TABLE)
;	 .WORD	SWITCH BIT
;	 .WORD	MAXIMUM VALUE
;	 .WORD	MINIMUM VALUE
;	 .WORD	ADR OF BYTE VARIABLE

LIMITS:	MOV	@(R5)+,R0	;LAST SPECIFIED VALUE
	BIT	(R5)+,SWITCH	;SWITCH SPECIFIED?
	BNE	1$		; YES
	TST	(R5)+		;SKIP MAX VALUE
	BR	3$		; & USE LAST VALUE

1$:	CMP	(R5)+,R0	;CHECK MAX
	BHIS	2$		; OK
	MOV	-2(R5),R0	;CLAMP HI
2$:	CMP	(R5),R0		;CHECK MIN
	BLOS	3$		; OK
	MOV	(R5),R0		;CLAMP LO
3$:	TST	(R5)+		;PT TO VARIABLE PTR
	MOVB	R0,@(R5)+	;SET VALUE INTO VARIABLE
	RTS	R5		;LEAVE

	.SBTTL	    COPYRL: PAD LINES TO SAME LENGTH

COPYRL:	MOV	R0,-(SP)	;SAVE REGS
	MOV	R1,-(SP)
	MOV	R2,-(SP)
	MOV	#BUFOUT,R0	;PAD INTO BUFOUT
	CMP	R0,6+2+2(SP)	;USING BUFOUT?
	BEQ	2$		; YES, DON'T HAVE TO COPY

	MOV	6+2+2(SP),R1	;GET BUFFER HEADER ADR
	MOV	R0,6+2+2(SP)	; & REPLACE WITH BUFOUT
	ADD	#4,R0		;PT TO ACTUAL BYTE COUNT
	ADD	#4,R1
	MOV	(R1)+,R2	;DATA LENGTH
	CMP	#MAXWID+2,R2	;TOO LONG?
	BHIS	10$		; NO
	MOV	#MAXWID+2,R2	; YES, CLAMP AT BUFFER SIZE
10$:	MOV	R2,(R0)+	;COPY IT
1$:	MOVB	(R1)+,(R0)+	;COPY BUFFER
	DEC	R2
	BGT	1$
2$:
	MOV	#BUFOUT+4,R0	;PT TO BYTE COUNT
	CLR	R2
	BISB	PADW,R2		;GET TOTAL WIDTH
	ADD	#2,R2		;FOR CR, LF
	MOV	(R0),R1		;CURRENT LENGTH (INC. CR, LF)
	MOV	R2,(R0)		;SET CONSTANT LENGTH
	ADD	R1,R0		;PT TO CR
	SUB	R1,R2		;AMOUNT TO PAD
	BGT	3$		; MUST PAD
	ADD	R2,R0		;TRUNCATE
	BR	4$
3$:	MOVB	#SPACE,(R0)+	;PAD
	DEC	R2
	BGT	3$		; MORE
4$:	.IIF DF,VRSATK,MOVB #'!,-1(R0)	;VERSATEK MUST HAVE NON-BLANK AT END
	MOVB	#XCR,(R0)+	;INSERT CR
	MOVB	#XLF,(R0)+	; & LF
	MOV	(SP)+,R2
	MOV	(SP)+,R1
	MOV	(SP)+,R0
	RTS	PC

	.SBTTL	    READL: READ A LINE

READL:	MOV	R4,CHRCNT	;CHARACTER COUNT BYTE PTR
	CLR	R3		;CHAR COUNT
	MOV	OVRFLO,R1	;PNT TO NEXT CHAR IN LINE
	BEQ	1$		; NO OVERFLOW

	.SBTTL	        FINISH LAST LINE OVERFLOW, IF ANY

	.IF	DF,..FA
	MOVB	#'>,-(R1)	;PUT "-->" IN PLACE
	MOVB	#'-,-(R1)
	MOVB	#'-,-(R1)
	.IFF
	MOVB	FA$L+2,-(R1)
	MOVB	FA$L+1,-(R1)
	MOVB	FA$L,-(R1)
	.ENDC
	CLR	OVRFLO		;CLEAR OVERFLOW FLAG
	BR	2$		;HAVE LINE WITH R1 SET

	.SBTTL	        READ NEXT INPUT LINE

1$:	MOV	#BUFIN,-(SP)	;PUSH BUF HDR
	MOV	#DTIFDB,-(SP)	;PUSH FDB
	JSR	PC,RSXRED	;READ (GET) DATA
	CMP	(SP)+,(SP)+	;RESTORE STACK
	BITB	#100,BUFIN+3	;EOD?
	BNE	EOT		; YES
	MOV	#BUF,R1		;SET R1 TO PT TO NEW LINE

2$:
	.PAGE

	CLRB	(R4)+		;ZERO CHARACTER COUNT BYTE
	MOV	#10,R5		;SET FIRST TAB STOP

	.SBTTL	        PROCESS NEXT CHARACTER

	.ENABLE LC
NEXTC:	MOVB	(R1),R0		;GET NEXT CHAR
	BICB	#^C177,(R1)
	BIC	#^C177,R0	;LEAVE 7 BITS ONLY (IN CASE OF SCREWY WORD PROCESSORS)
	BEQ	IGNORE		;IGNORE NULLS
	BIT	#SW.UC,SWITCH	;CASE TRANSLATION NEEDED?
	BEQ	CKSPC2		;NO.
	BITB	#100,(R1)	;IF 100 BIT ON, THEN 40 BIT OFF IF SPEC.
	BEQ	CKSPC
	BICB	#40,(R1)	;CONVERT LOWER TO UPPER CASE
	BR	CKSPC		;GO SKIP LOWER CASE NOW
CKSPC2:	BIT	#SW.LC,SWITC2	;/LC CONVERSION TO LOWER CASE FORCING DESIRED?
	BEQ	CKSPC		;IF EQ NO, SKIP IT
	CMPB	(R1),#100	;LEAVE @ ALONE
	BEQ	CKSPC
	CMPB	(R1),#'Z	;LEAVE EVERYTHING ABOVE Z ALONE TOO
	BHI	CKSPC
	BITB	#100,(R1)	;IF YES FORCE ON BIT 40 IF BIT 100 IS ON
	BEQ	CKSPC		;IF NOT BIT 100 ON, NOT IN RANGE
	BISB	#40,(R1)	;LOWER CASE NOW
CKSPC:
	CMP	#40,R0		;SEE IF SPECIAL
	BLOS	MOVE		; NO, COPY CHARACTER
	SUB	#15,R0
	BEQ	EOL		;CR
	BGT	CONTROL		;OUTPUT ^X
	ADD	R2,R0
	BGT	FF		;FF
	BEQ	EOL		;VT
	ADD	R2,R0
	BGT	EOL		;LF
	BLT	CONTROL		;001-010
	BIT	#SW.CT,SWITCH	;WANT TO KEEP TABS?
	BEQ	TAB		; YES
	MOVB	#SPACE,(R1)	;REPLACE TAB WITH SPACE
	BR	MOVE

	.SBTTL	            CONTROL CHARACTER

CONTROL:
	BIT	#SW.NE,SWITC2	;ARE WE PRINTING ESC AS ^[  OR  $?
	BNE	1$		;PRINTING AS ^[ SO DO IT
	CMPB	#33,(R1)	;THIS AN ESCAPE CHARACTER?
	BNE	1$		;NO, ECHO AS ^<CHAR>
	MOVB	#'$,(R1)	;PRINTING AS DOLLAR SIGN SO HANDLE THAT WAY
	BR	MOVE		;THEN SHOVE IT OUT. (DEFAULT = $ )
1$:	BISB	#100,(R1)	;FORCE PRINTABLE
	MOVB	#'^,(R4)+	;INSERT ^ CHARACTER
	BR	SPEC

	.SBTTL	            IGNORE CHARACTER

IGNORE:	INC	R1
	BR	NEXTC

	.SBTTL	            FORM FEED

FF:	BIT	#SW.FF,SWITCH	;WANT TO KEEP FFS?
	BEQ	EOL		; NO
	TSTB	LINE		;AT TOP OF COLUMN?
	BEQ	EOL		; YES, DON'T BLANK WHOLE COLUMN
	BR	E1		;YES, FILL COLUMN WITH BLANK LINES
	.PAGE

	.SBTTL	            TAB

TAB0:	ADD	#10,R5		;MOVE TO NEXT TAB STOP
TAB:	CMP	R3,R5		;AT TAB STOP?
	BGE	TAB0		;MOVE TO NEXT
	INC	R1		;SKIP TAB IN INPUT LINE
TAB1:	MOVB	#SPACE,(R4)+	;FILL WITH SPACES
	INC	R3		;COUNT CHARACTER
	CMPB	R3,WIDE		;MORE FIT IN LINE?
	BHIS	TOWIDE		; NO, FULL
	CMPB	R3,R5		;AT TAB STOP?
	BLO	TAB1		; NO, GET ANOTHER SPACE
	BR	NEXTC

	.SBTTL	            UNINTERESTING

MOVE:	MOVB	(R1)+,(R4)+	;COPY CHARACTER
SPEC:	INC	R3		;COUNT CHARACTER
	CMPB	R3,WIDE		;MORE FIT IN LINE?
	BLO	NEXTC		; YES, GET NEXT

	.SBTTL	        CHECK FOR COLUMN OVERFLOW

TOWIDE:	BIT	#SW.TR,SWITCH	;WANT TO TRUNCATE LINES?
	BNE	EOL		; YES, END LINE NOW
	CMPB	#XCR,(R1)	;IF AT CR
	BEQ	EOL		; NO OVERFLOW
	MOV	R1,OVRFLO	;SAVE NEXT CHARACTER PTR/SET FLAG

	.SBTTL	            LINE FEED - END OF LINE

EOL:	MOVB	R3,@CHRCNT	;INSERT LINE BYTE COUNT
	RTS	PC

	.SBTTL	        END OF INPUT FILE

EOT:	INCB	EOD		;REMEMBER SAW EOD
E1:	CLRB	(R4)+		;FILL REST COLUMN WITH
	INCB	LINE
	CMPB	LINE,LMAX	;NEED MORE?
	BLO	E1		; YES
;	CLR	AVAIL		;SAY NO AVAILABLE SPACE NOW
;	MOVB	COL,CMAX	;ALSO THAT WE HAVE GOT TO MAX COL ALLOWED
;;; NOTE SPECIAL STUFF NEEDED TO KEEP ENDFILE FROM LEAVING
;;; A VERY SHORT LAST LINE AS WHAT WE MUST FILL IN.
E2:	RTS	PC
	.PAGE

	.SBTTL	    WRITE A PAGE
	.SBTTL	        FIND COLUMN PADDING WIDTHS

PRINT:	MOVB	COL,R3		;ACTUAL # COLUMNS
	TSTB	VAR		;VARIABLE # COLS?
	BEQ	2$		; NO
	MOV	R3,SDIV1
	MOV	AVAIL,DDIV1	;FIND # EXTRA CHARACTERS PER COLUMN
	CLR	DDIV2
	JSR	R5,IDIV
	MOV	DDIV1,R0
	MOV	DDIV2,R1
1$:	MOVB	C-1(R3),R1	;GET COL WIDTH
	ADD	R0,R1		;ADD # EXTRA CHARS
	MOVB	R1,C-1(R3)	;UPDATE #
	DEC	R3
	BGT	1$
	BR	3$

2$:	MOVB	WIDE,C-1(R3)	;
	DEC	R3
	BGT	2$
3$:
	.SBTTL	        SETUP & OUTPUT APPROPRIATE HEADER

	INC	PAGEN		;GET PAGE #
	JSR	PC,RSAV		;SAVE REGS
	MOV	PAGEN,R0	;GET # TO CONVERT
	JSR	PC,BIN2D	;CONVERT IT
	JSR	PC,RRES		;POP REGS AGAIN
	MOV	PAGEAD,-(SP)	;PTR TO TENS DIGIT
	DEC	@SP		;MAKE IT POINT AT HUNDREDS
	CMPB	ZZ+2,#'0	;ZERO?
	BNE	100$		;NO
	MOVB	#40,ZZ+2	;YES, REPLACE WITH SPACE
100$:	MOVB	ZZ+2,@(SP)	;IN ANY CASE, COPY HUNDREDS DIGIT
	INC	@SP		;PASS HUNDREDS DIGIT;POINT TO TENS
	MOVB	ZZ+3,-(SP)	;COPY TENS DIGIT
	CMPB	#'0,(SP)	;IF NOT 0,
	BNE	4$		; KEEP IT
	MOVB	#SPACE,(SP)	;REPLACE WITH SPACE
4$:	MOVB	(SP)+,@(SP)	;INSERT TENS CHARACTER
	INC	(SP)		;PT TO UNITS
	MOVB	ZZ+4,@(SP)+	;COPY UNITS DIGIT
	CMP	PAGEN,#1	;ALLOW 1ST PAGE TO BE
			;WRITTEN IN ANY CASE
	BLE	LETGO
	BIT	#SW.PA,SWITCH	;/PAUSE OPTION ON?
	BEQ	LETGO		;NO, FORGET IT.
;PUT A WAIT ON READING CONSOLE HERE.
	GCML$	#CMD,#PAUSES,#PAULEN
	BR	X54$
PAUSES:	.ASCII	<15><12>/LIST PAUSE>/
PAULEN=.-PAUSES	;LET MACRO FIGURE OUT HOW LONG STRING IS!
	.EVEN
X54$:	BCC	LETGO
	RCML$	#CMD	;RESET LEVEL
	JMP	DONE		;EXIT IF ^Z ON PAUSE
LETGO:
	.PAGE

	BIT	#SW.RO,SWITCH	;ROLL PAPER?
	BEQ	9$		; NO
	MOV	#BUFOUT+4,R5	;PT TO ACTUAL BYTE COUNT
	MOVB	LINSIZ,(R5)	;SET IT TO FULL WIDTH
	MOV	(R5),-(SP)	;SAVE COUNT
	ADD	#2,(R5)+	; FOR CR, LF
10$:	MOVB	#'=,(R5)+	;CREATE PAGE DIVIDER
	DEC	(SP)		; MORE?
	BGT	10$		; YES
	TST	(SP)+		;DROP COUNTER
	MOVB	#XCR,(R5)+	;INSERT CR
	MOVB	#XLF,(R5)+	; & LF
	MOVB	ROLL0,ROLL	;SET PAGE LENGTH
	WRITE	#DTOFDB,#BUFOUT ;WRITE DIVIDER
; HERE SHOVE OUT ANY SECOND HEADER ALSO...
	BIT	#SW.EH,SWITC2	;SEE IF EXTRA HDR DESIRED
	BEQ	501$		; IF EQ NO, SKIP
	WRITE	#DTOFDB,#EHHDR	;IF SO WRITE IT OUT
501$:
	WRITE	#DTOFDB,#SKIP	; & SKIP A LINE
	BR	11$		;SKIP PAGED JUNK

9$:	.IF DF	NOFF1
	TSTB	OPENLP		;FIRST TIME?
	BNE	4$		; YES, OMIT FF
	.IFTF
	BIT	#SW.NP,SWITCH	;NO PAGE SEPARATORS?
	BNE	46$
	WRITE	#DTOFDB,#FORM
46$:
	.IFT
4$:	CLRB	OPENLP		;NO LONGER FIRST TIME
	.ENDC
11$:	BIT	#<SW.NH!SW.NP>,SWITCH	;OMIT HEADER?
	BNE	5$		; YES
	WRITE	#DTOFDB,#HEADER ;WRITE HEADER
; HERE SHOVE OUT ANY SECOND HEADER ALSO...
	BIT	#SW.EH,SWITC2	;SEE IF EXTRA HDR DESIRED
	BEQ	601$		; IF EQ NO, SKIP
	WRITE	#DTOFDB,#EHHDR	;IF SO WRITE IT OUT
601$:
	WRITE	#DTOFDB,#SKIP	; & SKIP A LINE
5$:

	.SBTTL	        FORM & OUTPUT LINES

	MOVB	LMAX,R5		;COUNT DOWN # LINES
	MOVB	COL,-(SP)	;SAVE # COLS ON PAGE
NEWL:	MOV	#L,PL		;START AT FIRST COL
	MOV	#C,PCO
	MOVB	(SP),COL	;# COLS ON PAGE
	MOV	#BUFA,R1	;PT TO OUTPUT LINE BUFFER
	.PAGE

NEWC:	MOV	@PL,R4		;PT TO LINE IN COL
	CLR	R0
	BISB	(R4)+,R0	;# CHAR IN LINE
	MOV	R0,R3		;SAVE IT FOR PADDING
	BEQ	2$		;LINE EMPTY
1$:	MOVB	(R4)+,(R1)+	;COPY CHARACTER
	DEC	R0
	BGT	1$		; AND DO NEXT
2$:	MOV	R4,@PL		;SAVE PTR TO NEXT LINE IN COL
	DECB	COL		;ONE LESS COL TO DO
	BEQ	CRLF		;DONE
	BISB	@PCO,R0		;GET COL WIDTH FOR PAD
	SUB	R3,R0		;# SPACES REQ'D
3$:	MOVB	#SPACE,(R1)+
	DEC	R0
	BGE	3$		;EXTRA SPACE FOR DIVIDER
	BIT	#SW.SC,SWITC2	;SEPARATOR CHARACTER SPECIFIED?
	BEQ	102$		;NO, SEE IF BLANK WANTED
	BIT	#SW.BS,SWITC2	;SPECIFIED SEPARATOR AND BLANK?
	BEQ	100$		;NO
;	BOTH /SC AND /BL SWITCHES SET. REMOVE EXTRA BLANK AND USE CHAR.
	DEC	R1		;**** EXPERIMENTAL *** FORGET EXTRA BLANK
				;IF USING BLANK AS SEPARATOR.
	BR	100$
102$:	BIT	#SW.BS,SWITC2	;WANT BLANK AS SEPARATOR?
	BEQ	100$		;NO
	MOVB	#40,(R1)+
	BR	101$		;YES. FILL IT IN
100$:	MOVB	SEPCHR,(R1)+	;NO, FILL IN SEPARATOR (INITIALLY "!")
;	MOVB	#'!,(R1)+
101$:	ADD	R2,PL		;MOVE TO NEXT COL
	INC	PCO
	BR	NEWC

CRLF:	MOVB	#XCR,(R1)+
	MOVB	#XLF,(R1)+
	SUB	#BUFOUT+6,R1	;GET LINE LENGTH
	MOV	R1,BUFOUT+4	;SET ACTUAL BYTE COUNT

	WRITE	#DTOFDB,#BUFOUT

	DECB	R5		;MORE LINES?
	BGT	NEWL		; YES
	MOVB	(SP)+,COL	;CLEAN STACK

	BIT	#SW.RO,SWITCH	;ROLL PAPER?
	BEQ	2$		; NO
1$:	TSTB	ROLL		;NEED ANOTHER LINE?
	BLE	2$		; NO
	WRITE	#DTOFDB,#SKIP
	BR	1$
2$:
	RTS	PC

	.PSECT	RWDATA,RW
	.SBTTL	    WRITE COMMAND MESSAGE

	.SBTTL	FILE CONTROL BLOCKS
SEPCHR:	.WORD	"!!	;SEPARATOR CHARACTER FOR COLUMNS
BUFIN:	.WORD	MAXWID
	.WORD	20
	.WORD	0
BUF:	.BLKB	MAXWID+2

	.SBTTL	LINE BUFFERS

	.EVEN
LPBK:	.WORD	MAXWID+2,4,0,0

PDIBUF:	.WORD	2,0,2	;CHARACTERS FOR USER TO TYPE
	.BLKW	2	;IF /PAUSE REQUESTED

BUFOUT:	.WORD	MAXWID+2
	.WORD	20
	.WORD	0
BUFA:	.BLKB	MAXWID+2+2 ;(SAFTEY)
	.PAGE

	.SBTTL	VARIABLES

COL:	.BYTE	0	;COLUMN COUNTER
	.EVEN
CMAX:	.WORD	0	;MAX # COLS
	.EVEN		;LINE MUST BE EVEN
LINE:	.BYTE	0	;COUNT DOWN LINES
LMAX:	.BYTE	0	;# TEXT LINES/PAGE
	.EVEN
PAGSIZ:	.WORD	84.	;CURRENT # LINES PER PAGE(INCL. HEADER)
	.EVEN
LINSIZ:	.WORD	130.	;# PRINT POSITIONS (EXCL. CR, LF)
MAX:	.BYTE	0	;MAX # CHAR IN COL SO FAR
VAR:	.BYTE	0	;NZ => VARIABLE # COLS
	.EVEN		;WIDE MUST BE EVEN,
			; NOTE HIGH BYTE USUALLY 0
WIDE:	.BYTE	0	;MAX # CHARACTERS PER COLUMN
EOD:	.BYTE	0	;NZ => SAW EOD
EDVAL:	.WORD	0	;CHARACTER TO FILL IN ON /ED
ROLL0:	.WORD	56.	;LINE PER ROLL PAGE
ROLL:	.BYTE	0	;LINES LEFT TO GO
	.EVEN
PADW:	.WORD	132.	;RECORD LENGTH FOR /RL
SKPLTR:	.WORD	0	;# INPUT LETTERS TO SKIP IF /SL:NNN ASKED
	.IF	DF,NOFF1
OPENLP:	.BYTE	0	;0 => DOING FIRST FILE
	.ENDC
	.EVEN
AVAIL:	.WORD	0	;# FREE CHARACTER POSITIONS REMAINING ON PAGE
CHRCNT:	.WORD	0	;PTR TO LINE BYTE COUNT BYTE
OVRFLO:	.WORD	0	;NZ IS ADR OF NEXT CHAR IN OVERFLOW LINE
PAGEAD:	.WORD	0	;PTR TO PAGE TENS IN HEADER
PAGEN:	.WORD	0	;LAST PAGE #
ZZ:	.ASCII	/00001/<0>	;FOR DECIMAL ASCII
PP:	.WORD	0	;SAVE FOR @PL(I+1)
PL:	.WORD	0	;PTR TO CURRENT L
PCO:	.WORD	0	;PTR TO CURRENT C
L:	.REPT	24.
	.WORD	BUF	;ADR OF FIRST LINE OF ITH COLUMN IN BLOCK
	.ENDR
C:	.REPT	20.
	.BYTE	16.	;WIDTH OF ITH COLUMN
	.ENDR
	.BYTE	10.,10.,10.,10.
		;TABLE OF FIXED COLUMN WIDTHS
WIDTH:	.REPT	20.
; ENTRY I IS:  MAXWID+2-<2*I>/2
	.BYTE	20.
	.ENDR
	.BYTE	10.,10.,10.,10.	;SPARES, BUT ALL INITIALIZED.
	.PAGE

	.EVEN
DDIV1:	.WORD 0	;VAR FOR DEVIDE ROUTINE
DDIV2:	.WORD 0
SDIV1:	.WORD 0
SMUL1:	.WORD 0	;VAR FOR MUL ROUTINE
DMUL1:	.WORD 0
SAVE:	.WORD 0
;MULTIPLY / DIVIDE ROUTINE
	.SBTTL	SWITCHES

	.EVEN
	.GLOBL	SWITC2,SWITCH
SWITC2:	.WORD	0	;MORE SWITCH FLAGS
SW.SC=1			;SEPARATOR CHARACTER
SW.BS=2			;BLANK SEPARATE
SW.NE=4			;NE TREAT ESCAPE PRINT AS ^[ (DEFAULT IS $)
SW.RI=10		;/RI:NNN SHIFT OUTPUT RIGHT NNN SPACES
SW.LC=20		;/LC FORCE LOWER CASE OUTPUT
SW.NS=40		;/NS FORCE NO SPACES RECOGNIZED ON INPUT
SW.FA=100		;/FA:LLL USES "LLL" AS CONT INDICATOR
SW.EH=200		;/EH:TEXTSTRING OUTPUTS 2ND HDR
SWITCH:	.WORD	0	;SWITCH FLAGS
SW.MAX=40000		;LEFTMOST SWITCH BIT
SW.MS=40000		;REMOVE MULTIPLE SPACES (MAKE SINGLE SPACES) IF /MS
			;SWITCH SET
SW.SL=20000		;SKIP LETTERS /SL:NNN TO SKIP NNN CHARS ON INPUT
			;IN EACH RECORD
SW.NP=10000		;NO PAGES (NO FORMFEED OR HEADER)

SW.UC=4000		;CONVERT LOWER TO UPPER CASE
	.WORD	"UC,0
SW.RL=2000		;FIXED LENGTH LINES
	.WORD	"RL,132.
SW.RLN=.-2

SW.RO=1000		;ROLL PAPER
	.WORD	"RO,56.
SW.ROL=.-2

SW.CT=400		;CHANGE TAB TO SPACE
	.WORD	"CT,0	;NO ARGS

SW.ED=200		;USE ^D INSTEAD OF FF
	.WORD	"ED,0

SW.PA=100		;PAUSE OPTION
	.WORD	"PA,0

SW.WI= 40		;WIDTH OPTION
	.WORD	"WI,127.
SW.WID=.-2

SW.LE= 20		;LENGTH OPTION
	.WORD	"LE,84.
SW.LEN=.-2

SW.CO= 10		;# COLUMNS
	.WORD	"CO,0.
SW.COL=.-2

SW.FF =4		;RETAIN FF OPTION
	.WORD	"FF,0

SW.NH =2		;NO HEADER OPTION
	.WORD	"NH,0

SW.TR =1		;TRUNCATE OPTION
	.WORD	"TR,0
	.EVEN
	.PSECT	CRUD
SWTBL:	CSI$SW	UC,SW.UC,SWITCH	;UPPER CASE /UC SWITCH
	CSI$SW	RL,SW.RL,SWITCH,,,RLTBL	;	/RL:NNNNN
	CSI$SW	RO,SW.RO,SWITCH,,,ROTBL;	/RO:NNNNN
	CSI$SW	CT,SW.CT,SWITCH	;COMPRESS TABS /CT
	CSI$SW	ED,SW.ED,SWITCH,,,EDTBL	;	/ED:NNN (NNN=CHAR OCT)
	CSI$SW	PA,SW.PA,SWITCH	;/PAUSE (NYA)
	CSI$SW	WI,SW.WI,SWITCH,,,WITBL	;/WI:NNN
	CSI$SW	LE,SW.LE,SWITCH,,,LETBL	;/LE:NNN
	CSI$SW	CO,SW.CO,SWITCH,,,COTBL	;/CO:N
	CSI$SW	FF,SW.FF,SWITCH		;/FF
	CSI$SW	EH,SW.EH,SWITC2,,,EHTBL	;/EH:TEXT-STRING FOR 2ND HDR LINE
	CSI$SW	NH,SW.NH,SWITCH		;/NH NO HDR
	CSI$SW	TR,SW.TR,SWITCH		;/TRUNCATE COL
	CSI$SW	NP,SW.NP,SWITCH		;/NP  NO PAGE SEPARATORS
	CSI$SW	SL,SW.SL,SWITCH,,,SLTBL	;/SL:NNN SKIP LETTERS
	CSI$SW	MS,SW.MS,SWITCH		;/MS MAKE MULTIPLE SPACES SINGLE SP'S
	CSI$SW	SC,SW.SC,SWITC2,,,SCTBL	;/CS:CHAR FILL IN COLUMN SEPARATOR CHR
	CSI$SW	BS,SW.BS,SWITC2		;/BS BLANK SEPARATOR FOR COLUMNS
	CSI$SW	NS,SW.NS,SWITC2
	CSI$SW	NE,SW.NE,SWITC2		;/NE NO ESCAPE SPECIAL ECHO (TREAT AS
					;NORMAL CONTROL CHARACTER.)
	CSI$SW	RI,SW.RI,SWITC2,,,RITBL	;/RI:NNN SHIFTS OUTPUT RIGHT NNN SPACES
	CSI$SW	LC,SW.LC,SWITC2		;/LC FORCES ALL LOWER CASE
	CSI$SW	FA,SW.FA,SWITC2,,,FATBL
	CSI$ND	;END TABLE
	CSI$SV	DECIMAL,PADW,2,RLTBL
	CSI$SV	DECIMAL,ROLL0,2,ROTBL
	CSI$SV	OCTAL,EDVAL,2,EDTBL
	CSI$SV	DECIMAL,LINSIZ,2,WITBL
	CSI$SV	DECIMAL,PAGSIZ,2,LETBL
	CSI$SV	DECIMAL,CMAX,2,COTBL
	CSI$SV	DECIMAL,SKPLTR,2,SLTBL
	CSI$SV	ASCII,SEPCHR,1,SCTBL
	CSI$SV	DECIMAL,RIVAL,2,RITBL
	CSI$SV	ASCII,FA$L,3,FATBL
	CSI$SV	ASCII,EHTXT,80.,EHTBL
	CSI$ND
OUTCSW:
OUTSWS:
	CSI$SW	AP,1,OSMSK	;/AP OPEN OUTPUT FOR APPEND
	CSI$SW	SP,2,OSMSK,,,SPCPY ;/SP:N SPOOL N COPIES
	CSI$ND
	CSI$SV	DECIMAL,SPCNT,2,SPCPY
	CSI$ND
	.PSECT	RWDATA,RW
RIVAL:	.WORD	0		;/RI:NNN SWITCH VALUE
FA$L:	.ASCIZ	/-->/	;LINE CONTINUE INDICATOR
	.EVEN
EHHDR:	.WORD	82.,0,82. ;FAKE DOS WRITE BUFFER HDR
EHTXT:	.BLKB	80.
	.BYTE	15,12	;CR,LF TO FILL IN
	.EVEN
	.PAGE

	.SBTTL	TEXT STRINGS

OSMSK:	.WORD	0	;OUTPUT FILE SWITC MASKS. SEE OUTSWS TBL
				;FOR BIT DEFS
SPCNT:	.WORD	0	;NO. COPIES TO SPOOL IF SPOOLING OUTPUT
L3:	.WORD	LL3
	.BYTE	15,12,0,0,0,0,0
VERSON:	.ASCII	/LIST-11 VR3.3/
VERLEN=.-VERSON
	.BYTE	XCR,XLF
LL3=.-L3-2

	.EVEN
	.IF	EQ,1	;NEVER TRUE THAT 1=0 !!
L4:	.WORD	LL4
	.ASCII	<0><0><0>/#/<13>
LL4=.-L4-2

	.EVEN
L5:	.WORD	LL5
	.ASCII	<15><12>/*/<13>	;STANDARD PROMPT
LL5=.-L5-2
	.ENDC	;END OF OMITTED SECTION
	.EVEN
HEADER:	.WORD	MAXWID+2,0,0
DASH:	.BLKB	MAXWID+2

PAGE:	.ASCII	/ XX-XXX-XX PAGE  XX /<15><12>
TAIL:
TALSIZ=TAIL-PAGE
MINWID=10.*6
	.IF LT	MINWID-VERLEN
MINWID=VERLEN
	.ENDC
	.IF LT	MINWID-TALSIZ
MINWID=TALSIZ
	.ENDC

	.EVEN
FORM:	.WORD	3,0,3	;FORM FEED
	.BYTE	14,15,12	;OR ^D IF /ED
;NOTE /ED IS FOR THE VT01 DRIVER THAT USES IT TO ERASE A SCREEN.
	.EVEN
SKIP:	.WORD	3,0,3	;CR LF
	.BYTE	SPACE,XCR,XLF

	.SBTTL	PAGE BUFFER

	.EVEN
BLOCK:	.BLKB	<<MAXWID+4>*MAXLIN>
; PCO -> C, PL -> L
; C CONTAINS WIDTH OF CURRENT COLUMN
; L CONTAINS ADDRESS IN BLOCK OF START OF CURRENT LINE
; BLOCK CONTAINS PACKED LINES:
;  FIRST BYTE IS # CHARACTERS TO FOLLOW
;  FOLLOWED BY CHARACTERS FROM LINE


	.PSECT	RCODE,RO
IDIV:	JSR PC,RSAV
	MOV #SDIV1,R1
	MOV #DDIV1,R0
	JSR	PC,DIVD
	JSR PC,RRES
	RTS R5
IMUL:	JSR PC,RSAV
	MOV #SMUL1,R1
	MOV #DMUL1,R0
	JSR PC,MULT
	JSR PC,RRES
	RTS R5
RSAV:	MOV R0,-(SP)		;SAVE REGISTERS
	MOV R1,-(SP)
	MOV R2,-(SP)
	MOV R3,-(SP)
	MOV R4,-(SP)
	MOV R5,-(SP)
	JMP @12.(SP)
RRES:	MOV (SP)+,12.(SP)	;STORE RETURN ADDRESS
	MOV (SP)+,R5		;RESTORE REGISTERS
	MOV (SP)+,R4
	MOV (SP)+,R3
	MOV (SP)+,R2
	MOV (SP)+,R1
	MOV (SP)+,R0
	RTS PC
;	PDP-11 FLOATING POINT PACKAGE
;	INTEGER MULTIPLY
;	INTEGER DIVIDE
;
;	MODULES INCLUDED:
;	1. MUL
;	2. DIV
;
;
;
;
R0	=	%0
R1	=	%1
R2	=	%2
R3	=	%3
R4	=	%4
R5	=	%5
SP	=	%6
PC	=	%7
MULT:	MOV	@R0,R5		;PICK UP THE MULTIPLIER
	MOV	@R1,R1		;PICK UP THE MULTIPLICAND
	CLR	R3		;ZIP-ZAP-ZOWIE AND SWOSH
	CLR	R4
	TST	R5
	BGE	.+6	;->	;TEST SIGN AND CHANGE IF NECESSARY
	NEG	R5	;  I	;CHANGE SIGN
	INC	R3	;  I	;REMEMBER THE ORIGINAL SIGN
	TST	R1	;<-	;TEST THE OTHER WORD
	BGE	.+6	;->	SAME TEST AS BEFORE
	NEG	R1	;  I	;NEGATE TO CHANGE THE SIGN
	DEC	R3	;  I	;USE THE OPPOSITE SIGN MANAGEMENT
	MOV	#21,R2	;<-	;SET UP THE CYCLE COUNTER
M.ML1:	CLC			;CLEAR CARRY FOR ROTATES
	ROR	R4		;SHIFT MULTIPLIER AND PARTIAL PRODUCT
	ROR	R5
	BCC	.+4	;->	;CHECK AND SEE IF AN ADDITION IS NEEDED
	ADD	R1,R4	;  I	;ADD MULTIPLIER TO PARTIAL PRODUCT
	DEC	R2	;<-	;DECREMENT COUNTER
	BGT	M.ML1		;BREANCH IF MORE TO DO
	TST	R3		;TEST SIGN CHANGE WORD
	BEQ	.+10	;->	;BRANCH AROUND THE ADJUSTMENT
	NEG	R4	;  I	
	NEG	R5	;  I
	SBC	R4	;  I	;DO A DOUBLE PRECISION NEGATION
	MOV	R5,(R0)+;<-
	MOV	R4,@R0		;MOVE THE PRODUCT TO DESTINATION
	RTS	PC		;RETURN TO THE CALLER
DIVD:	CLR	-(SP)		;SET UP A SIGN CONTROL WORD
	MOV	(R0)+,R3	;PICK UP THE
	MOV	(R0)+,R2	;DOUBLE PRECISION DIVIDEND
	BGE	.+14	;->	;CHECK THE SIGN
	DECB	1(SP)	;  I	;KEEP TRACK OF THE ORIGINAL
	NEG	R2	;  I	;SIGN AND NEGATE
	NEG	R3	;  I	;THE ORIGINAL NUMBER
	SBC	R2	;  I
	MOV	(R1)+,R4;<-	;PICK UP THE DIVISOR
	BEQ	M.DVV		;DIVISION BY ZERO IS A NO-NO
	BGT	.+6	;->	;CHECK THE SIGN
	INC	@SP	;  I	;AND KEEP TRACK AS ABOVE
	NEG	R4	;  I
	MOV	R4,R5	;<-	;MOVE THE DIVISOR AND
	NEG	R5		;NEGATE FOR THE ALGORITHM
	ADD	R5,R2		;PREFORM THE INITIAL SUBTRACTION
	BCS	M.DVV		;CARRY SET IS AN OVERFLOW
	MOV	#20,-(SP)	;SET UP A COUNTER
	CLR	-(SP)		;THIS IS A LASTING CARRY BIT
M.DV1:	ROL	R3		;ROTATE ONE LEFT
	ROL	R2
	TST	@SP		;CHECK THE LAST CARRY
	BEQ	M.DV2		;IF ZERO ADD ELSE SUBTRACT
	CLR	@SP		;CLEAR THE CARRY
	ADD	R5,R2		;DO ONE MORE STEP
	BR	M.DV3
M.DV2:	ADD	R4,R2		;-2N+N=N FOR THIS STEP
M.DV3:	ADC	@SP		;KEEP IT A WHILE
	BEQ	.+4	;->	;IF ZERO OMIT UPDATE
	INC	R3	;  I	;NO CARRY POSSIBLE
	DEC	2(SP)	;<-	;DECREMENT COUNTER
	BGT	M.DV1		;BRANCH IF MORE TO DO
	ROR	R3		;SEE ABOUT THE LAST CYCLE
	BCS	M.DV4		;OMIT CORRECTION IF ONE
	ADD	R4,R2		;CORRECT REMAINDER
	CLC
M.DV4:	ROL	R3		;REPLACE THE LAST BIT
	CMP	(SP)+,(SP)+	;POP TWO WORDS
	TST	@SP		;TEST FOR REMAINDER CHANGES
	BGE	.+12	;->	;OMIT IF POSITVE
	NEG	R2	;  I	;NEGATE REMAINDER
	CLRB	1(SP)	;  I	;CLEAR SIGN
	DEC	@SP	;  I	;BUT DO A GOOD JOB ON QUOTIENT
	CMP	#100000,R3;<-	;TEST FOR THE BUG IN THE ALGORITHM
	BLO	M.DVV		;EXIT WITH ERROR OF TOO BIG
	BEQ	M.DVC		;CHECK FOR OVERFLOW
M.DV6:	TST	(SP)+		;TEST FOR QUOTIENT ADJUSTMENT
	BEQ	M.DV5		;IF ZERO NONE NEEDED
	NEG	R3		;NEGATE QUOTIENT
M.DV5:	MOV	R2,-(R0)	;MOVE REMAINDER
	MOV	R3,-(R0)	;THEN QUOTIENT TO DEST.
	RTS	PC
M.DVV:	TST	(SP)+		;REMOVE SIGN WORD
	SEV			;SET OVERFLOW
	RTS	PC
M.DVC:	TST	(SP)		;TEST FOR NEGATIVE
	BEQ	M.DVV		;IF POSITIVE THEN OOPS!
	BR	M.DV6		;IF NEGATIVE OK

;	ROUTINES TO HANDLE DATE AND BINARY TO ASCII UTILITY
;	CONVERSIONS

RADTBL:	.ASCII	/ ABCDEFGHIJKLMNOPQRSTUVWXYZ.$?0123456789/
	.EVEN	;RAD50 CHARACTER SET TABLE
RADUP:	MOV	R0,-(SP)	;R0 CONTAINS RADPACKED CODE ON ENTRY
	MOV	R1,-(SP)
	MOV	R2,-(SP)	;R2 HAS ADDR TO PUT ASCII IN
	MOV	R3,-(SP)
	MOV	#3,R3	;3 CHARS
	ADD	#3,R2	;TRANSLATE RIGHT TO LEFT
1$:	MOV	R0,R1	;PUT # IN ODD REG
	CLR	R0
	CLC
	DIV	#50,R0	;DIVIDE TO GET REMAIND. IN R1, QUOT IN R0
	MOVB	RADTBL(R1),-(R2)	;STICK INTO USER AREA
	SOB	R3,1$		;DO ALL 3 CHARS
	MOV	(SP)+,R3
	MOV	(SP)+,R2
	MOV	(SP)+,R1
	MOV	(SP)+,R0
	RTS	PC
BIN2D:	JSR	PC,RSAV	;SAVE REGS
	MOV	#5,R4	;CONVERT ENTRY R0 TO 5 ASCII NUMBERS
	MOV	#ZZ+5,R3	;IN ZZ, IN DECIMAL FOR PAGE #
1$:	MOV	R0,R1	;R0 HAS NUMBER, R3 HAS OUTPUT
	CLR	R0
	CLC
	DIV	#12,R0	;DIVIDE BY 10 TO GET DIGIT
	ADD	#60,R1	;ADD ASCII ZONES
	MOVB	R1,-(R3)
	SOB	R4,1$
	JSR	PC,RRES	;PUT REGS BACK
	RTS	PC
;
;DATE CONVERTING ROUTINES
;
MONTHS:	.ASCII	/-FOO-JAN-FEB-MAR-APR-MAY-JUN-JUL-AUG-SEP-OCT-NOV/
	.ASCII	/-DEC-FOO/
	.EVEN
	.PSECT	RWDATA,RW
TIMBUF:
TIMYR:	.WORD	0;YEAR
TIMMON:	.WORD	0
TIMDA:	.WORD	0	;DAY OF MONTH
	.BLKW	5	;OTHER JUNK
	.PSECT	RCODE,RO
CVTDT:	JSR	PC,RSAV
	.MCALL	GTIM$S
	GTIM$S	#TIMBUF	;GET DATE, TIME, ETC. AND
		;SAVE ASCII DATE STUFF IN AREA POINTED AT
		;BY ENTRY R5.
	MOV	R5,R2	;PREPARE FOR DAY FIRST
	MOV	TIMDA,R0	;CONVERT DAY
	JSR	PC,NUM		;TO 2 ASCII DIGITS
	MOV	TIMMON,R1
	ASL	R1
	ASL	R1		;MULT MONTH BY 4
	ADD	#MONTHS,R1	;GET ADDR OF 4 ASCII CHARS
	ADD	#2,R5		;POINT R5 PAST DAY
	.REPT	4
	MOVB	(R1)+,(R5)+
	.ENDR
	MOVB	#'-,(R5)+	;ADD A SECOND "-" AFTER MONTH
	MOV	R5,R2
	MOV	TIMBUF,R0	;YEAR-1900
	JSR	PC,NUM		;CONVERT ASCII
	JSR	PC,RRES		;PUT REGS BACK
	RTS	PC		;THAT'S ALL
;
;NUMBER CONVERT SUB TO GIVE 2 ASCII DIGITS FROM ENTRY R0
;PUTTING RESULT WHERE R2 POINTS
NUM:	JSR	PC,RSAV
	MOV	R0,R1
	CLR	R0
	DIV	#12,R0	;DIV ON EVEN REG
	ADD	#60,R0
	ADD	#60,R1	;ADD ASCII TO QUOT AND REM
	MOVB	R0,(R2)+
	MOVB	R1,(R2)+	;PUT OUT #
	JSR	PC,RRES
	RTS	PC
	.END	LIST