/ LISTING PROGRAM FOR OS/8

/ WRITTEN BY:
/ CLYDE G. ROBY, JR.
/ DEPARTMENT OF MEDICINE
/ WEST VIRGINIA UNIVERSITY
/ MORGANTOWN, WEST VIRGINIA
/ OCTOBER, 1970

/ MODIFIED BY HAROLD L. PEARSON, JR.
/ APRIL 7, 1971
/ AUGUST 1, 1972
/ DEPT. OF SURGERY

/ MODIFIED BY CGR  4/9/71

/ MODIFIED BY CGR  1/21/74 (VERSION 2)
/ ADDED IN LARGE LETTERS
/ CLEANED UP PAGE BREAKS

/ MODIFIED BY CGR 4/3/74 (VERSION 3)
/ CAPABILITY FOR MULTIPLE COPIES (=N OPTION)

/ MODIFIED BY CGR 5/15/74 (V4)
/ PAGE BREAK ACROSS ENTIRE PAGE IF TTY

	VERSION="4	/CURRENT VERSION OF LIST

FIXMRI INC=	2000	/ISZ WHEN NOT EXPECTED TO SKIP
FIXTAB

*20

PAGEB,	0	/0 TO TYPE OUT PAGE BREAK
ENDQ,	0	/END OF INPUT QUESTION LINE IF NON-ZERO
TITLEQ,	0	/0 IF TO PRINT OUT TITLE
CRSWIT,	7777	/0 IF NOT TO PRINT CR
OPTWD1,	0	/1ST OPTION WORD FROM CD
OPTWD2,	0	/2ND OPTION WORD FROM CD

	DECIMAL
MARTP1=	2	/# LINES FROM TOP OF PAGE TO TITLE
MARTP2=	3	/# LINES FROM TITLE LINE TO BODY
PAGSIZ=	66	/# LINES PER PAGE
MARBOT=	5	/# LINES FROM END OF BODY TO BOTTOM OF PAGE
BODY=	PAGSIZ-MARTP1-MARTP2-MARBOT

TP1,	-MARTP1
TP2,	-MARTP2
BDY,	-BODY
BOT,	-MARBOT
	OCTAL

LINSIZ,	0
COUNT,	0
TEMP,	0
NUMBER,	0
NUM1,	0
CTR,	0
UASCII,	0
TOPSW,	0
PAGEN,	0
PAGEP,	0
POINT,	0
CHARCT,	0
LINECT,	0
CHAR,	0
NSPACE,	0
ODNUM,	0
LZERO,	0
DIGCTR,	0
DIGIT,	0
OCTEMP,	0
LSWIT,	0		/1 IF NO LARGE LETTERS
LEFTAB,	0		/INITIAL LEFT MARGIN
NCOPY,	0		/NO. OF COPIES (=N OPTION)

DIGTAB,	-1750
	-144
	-12

GET=	JMS I .; INPUT
PUT=	JMS I .; OUTPUT
TYPE=	JMS I .; TYPEIT
PUTC=	JMS I .; XPUTC

TCRLF=	JMS .
	0
	TAD [215]
	TYPE
	TAD [212]
	TYPE
	JMP I .-5

DEVCHK,	0		/CHECK OUTPUT DEVICE FOR TTY:
	CLA IAC
	DCA TTYSWT	/SET FOR NON-TTY:
	TAD M81
	DCA LINSIZ
	CDF 10
	TAD I [7600]
	AND C17
	TAD PDCBM1
	DCA TEMP
	TAD I TEMP
	CDF 00
	SZA CLA
	JMP I DEVCHK
	DCA TTYSWT	/CLEAR FOR TTY:
	JMP I DEVCHK

C17,	17
PDCBM1,	7760-1
TTYSWT,	0		/=0 FOR TTY:
M73,	-111
M81,	-121

GETIT=	JMS .
	0
	CIF 10
	JMS I (XXGET)
	JMP I .-3

PUTIT=	JMS .
	0
	CIF 10
	JMS I (XXPUT)
	JMP I .-3

CLOSE=	JMS .
	0
	CIF 10
	JMS I (XXCLOSE)
	JMP I .-3

PAGE
/ LIST STARTS HERE AT 00200

	JMS WHOQ	/OUTPUT CURRENT VERSION
BEGIN,	CLA CLL
	TAD (-MARTP1
	DCA TP1
	TAD (-MARTP2
	DCA TP2
	TAD (-BODY
	DCA BDY
	TAD (-MARBOT
	DCA BOT
	JMS SETUPL	/CALL COMMAND DECODER AND SET UP I/O
	JMS DEVCHK	/SET BREAK OPTIONS FOR DEVICE TYPE
	CDF 10
	TAD I (7643)
	DCA OPTWD1	/SAVE FIRST OPTION WORD
	TAD I (7644)
	DCA OPTWD2	/SAVE SECOND OPTION WORD
	TAD I (7646)	/=N OPTION
	SNA
	IAC		/IF ZERO, ASSUME 1 COPY
	CIA
	DCA NCOPY	/NO. OF COPIES
	CDF 00
	TAD OPTWD2	/LOOK FOR /X OPTION SWITCH
	CLL RAR		/PUT IT IN LINK BIT
	SNL CLA		/IS THERE A /X ?
	JMP BEGIN2	/NO
	TAD OPTWD1	/YES, SET THE /A SWITCH,
	CLL RAL		/WHICH ALSO SETS /N SWITCH
	STL RAR
	DCA OPTWD1
BEGIN2,	TAD OPTWD1	/LOOK FOR OPTION CHAR "A"
	SMA CLA
	JMP .+5		/NOT "A"
	TAD OPTWD2	/IF "A", THEN
	RTL		/GET OPTION CHAR "N" TO LINK
	STL RTR		/SET "N", PUT IT BACK
	DCA OPTWD2
	STL RTR		/SET PAGEB IF /B
	AND OPTWD1
	DCA PAGEB	/IF /B, DO NOT TYPE PAGE BREAK
	TAD OPTWD2	/CHECK FOR "M" TO SET MARGINS
	SPA CLA		/FOR ADH LIST
	JMS ADHSET

	TAD (PAGTAB-1)
	DCA 10
	TAD (-30)
	DCA COUNT
	TAD OPTWD2
	AND (400)	/LOOK FOR OPTION CHAR "P"
	SZA CLA
	JMP PPAGES	/IF /P, ASK FOR PAGES TO PRINT
	CLA IAC
	DCA I 10	/SET UP PAGE TABLE TO PRINT ALL
	STL CLA RTR	/2000 TO ACC
	DCA I 10
	DCA I 10	/0 TO END THE TABLE
	JMP OPTV	/GO CHECK FOR /V

PPAGES,	JMS GETMESS	/ASK FOR PARTIAL PAGES
	 ENTPAG		/TYPE OUT THIS MESSAGE FIRST
	TAD [TITLEM-1]
	DCA 10
	TAD (PAGTAB-1)
	DCA 11
	DCA ENDQ	/NOT END OF LINE YET
PPAGE0,	DCA NUM1	/NOT AN A-B TYPE
NXTNUM,	JMS ASCBIN	/CONVERT ASCII TO BINARY
	SZA
	JMP PPAGE1
	STA
	DCA ENDQ	/END OF LINE
	JMP PPAGE2	/GET LAST PAGE OR PAGES
PPAGE1,	TAD (-255)	/IS IT A MINUS SIGN?
	SZA CLA
	JMP PPAGE2	/NOT MINUS
	TAD NUMBER	/A MINUS, SET UP FOR CONSECUTIVE PAGES
	DCA NUM1
	JMP NXTNUM
PPAGE2,	TAD NUM1	/CHECK FOR CONSECUTIVE
	SNA
	JMP SET1	/NO, JUST SET 1 PAGE
	CIA		/CONSECUTIVE FROM NUM1 TO NUMBER
	TAD NUMBER
	SPA CLA
	JMP PPAGES	/ASK AGAIN, BAD ARGS
	TAD NUM1
PPAGE3,	DCA I 11	/FIRST PAGE OF CONSECUTIVE
	TAD NUMBER
	DCA I 11	/SECOND PAGE OF CONSECUTIVE
	ISZ COUNT	/PAGE TABLE FULL?
	SKP
	JMP PPAGE4	/YES, PREPARE TO CHECK /V
	TAD ENDQ	/END OF INPUT LINE?
	SNA CLA
	JMP PPAGE0	/NOT END OF LINE, CHECK FOR MORE PAGES
PPAGE4,	DCA I 11	/0 ENDS THE TABLE
	JMP OPTV	/CHECK OPTION "V"

SET1,	TAD NUMBER	/SET 1 PAGE, USE NUMBER BOTH TIMES
	JMP PPAGE3

BREAK,	0
	TAD [215]
	PUT
	TAD [-106]
	DCA COUNT
	TAD ("-)	/OUTPUT 6 "-"
	PUT
	ISZ COUNT
	JMP .-3
	TAD [215]	/THEN A CARRIAGE RETURN
	PUT
	JMP I BREAK

PAGE
OPTV,	TAD OPTWD2
	AND (4)		/LOOK FOR OPTION CHAR "V"
	SZA CLA
	JMP OPTVT	/YES, SET UP VARIABLE TABS
	TAD OPTWD1
	AND (100)	/NO, LOOK FOR OPTION CHAR "F"
	SZA CLA
	JMP OPTF	/YES, SET UP FIXED TABS
	TAD (TABTAB)	/NO, SET UP FIXED TABS AT 8 COLUMNS
	DCA POINT
	TAD (-204)	/132 DECIMAL
	DCA COUNT
	STA
	DCA I POINT	/START IN COLUMN 1
STDTAB,	TAD [-10]
	DCA NUMBER	/SET TABS EVERY 8 COLUMNS
TLOOP,	TAD NUMBER
	TAD I POINT
	INC POINT
	DCA I POINT	/SAVE NEXT TAB POSITION
	ISZ COUNT
	JMP TLOOP
	JMP OPTT	/GO LOOK FOR "T"

OPTF,	JMS GETMESS	/GET INPUT LINE FOR FIXED TABS
	 ENTABF		/MESSAGE TO PRINT
	TAD [TITLEM-1]
	DCA 10
	TAD (TABTAB)
	DCA POINT	/SET UP POINTER AND COUNTER
	TAD (-204)
	DCA COUNT
	STA
	DCA I POINT
	JMS ASCBIN	/GET FIXED TAB NUMBER
	CLA		/DON'T CARE WHAT ENDED IT
	TAD NUMBER
	CIA
	JMP STDTAB+1	/GO FILL TABLE

OPTVT,	JMS GETMESS	/GET INPUT LINE FOR TABS
	 ENTABV		/MESSAGE TO PRINT OUT
	TAD [TITLEM-1]
	DCA 10
	TAD (TABTAB)
	DCA POINT	
	TAD (-204)	/132 DECIMAL
	DCA COUNT	/DO NOT OVERFLOW TABLE
	DCA ENDQ	/NOT END OF LINE YET
	STA
	DCA I POINT	/SAVE TAB POSITION
GETTAB,	JMS ASCBIN	/GET A TAB POSITION
	DCA ENDQ	/END OF LINE ENCOUNTERED
	TAD I POINT
	CIA
	TAD NUMBER
	SPA
	JMP OPTV	/ERROR IN INPUT LINE
	SZA CLA
	INC POINT	/NOT EQUAL TO LAST TAB
	TAD NUMBER
	CIA
	DCA I POINT	/SAVE TAB IN TABLE
	ISZ COUNT	/ALL TAB POSITIONS FILLED?
	SKP
	JMP OPTT	/YES, GET OPTION "T"
	TAD ENDQ
	SZA CLA
	JMP GETTAB	/GET NEXT TAB
	JMP STDTAB	/GO FILL REST OF TABLE

OPTT,	DCA LEFTAB	/INIT LEFT TAB TO 0
	TAD OPTWD2	/LOOK FOR /T
	AND (20)
	SNA CLA
	JMP OPTL	/NO /T, CHECK /L OPTION
	JMS GETMESS	/GET THE TAB
	  ENTABT	/USE THIS MESSAGE
	TAD [TITLEM-1]	/FROM TITLE BUFFER
	DCA 10
	JMS ASCBIN	/GET THE NUMBER
	CLA		/IGNORE CHAR THAT ENDED IT
	TAD NUMBER
	DCA LEFTAB	/INITIALIZE LEFT MARGIN TAB

OPTL,	CLA IAC
	AND OPTWD1	/IS /L OPTION GIVEN?
	DCA LSWIT	/IF 1, NO LARGE LETTERS
	TAD TTYSWT
	SZA CLA		/OUTPUT TO TELETYPE?
	JMP OPTN	/NO
	CLA IAC		/YES, NO LARGE LETTERS
	DCA LSWIT

OPTN,	STL RTR		/TEST FOR /N
	AND OPTWD2	/LOOK FOR OPTION CHAR "N"
	DCA TITLEQ	/0 IF TO PRINT TITLE
	TAD TITLEQ
	SZA CLA
	JMP START	/IF /N, DO NOT ASK FOR TITLE
	JMS GETMESS	/ASK FOR TITLE
	 ENTITL		/USE THIS MESSAGE
	JMP START	/GO START MAIN PROGRAM

/ OUTPUT LINE FEEDS FROM "LARGE" SUBRS

LFOUT,	0
	DCA LFOCTR	/SAVE NO. OF LINE FEEDS TO OUTPUT
LFOUT1,	TAD [212]
	PUTC
	ISZ LFOCTR
	JMP LFOUT1
	JMP I LFOUT

LFOCTR,	0

PAGE
/ SUBROUTINE TO OUTPUT CHARS
/ CHECK FOR SPECIAL CHARACTERS AND SPEED UP THE OUTPUT

XPUTC,	0
	DCA UASCII	/SAVE ASCII CHAR
	TAD TOPSW	/MUST WE DO TOP OF PAGE BREAK?
	SZA CLA
XPUTC1,	JMS TBREAK	/YES, GO DO IT
	TAD UASCII	/GET ASCII CHAR BACK
	TAD [-212]
	SNA
	JMP LFEED	/LINE FEED
	TAD [212-215]
	SNA
	JMP CARRET	/CARRIAGE RETURN
	TAD [215-240]
	SNA
	JMP SPACE	/SPACES
	TAD [240-211]
	SNA
	JMP OUTTAB	/TAB
	TAD [211-214]
	SNA CLA
	JMP FFEED	/FORM FEED
	TAD NSPACE	/ANY SPACES YET?
	SNA
	JMP TYPOUT	/NO, GO TYPE OUT CHAR
	CIA
	DCA NSPACE	/YES, MAKE A COUNTER
	TAD [" ]
	PUT
	ISZ NSPACE	/OUTPUT N SPACES
	JMP .-3

TYPOUT,	STA
	DCA CRSWIT	/PRINT CARRIAGE RETURN
	TAD UASCII	/OUTPUT ASCII CHAR
	PUT
	JMS LCHECK	/CHECK LINE OVERFLOW
XPUTCR,	DCA NSPACE	/NO SPACES
	JMP I XPUTC

LFEED,	TAD [212]	/OUTPUT A LINE FEED
	PUT
	ISZ LINECT	/AT BOTTOM OF PAGE
	JMP LFEED3
	TAD PAGEN
	SPA SNA CLA	/GET NEXT CHAR ON PAGE?
	JMP LFEED4	/NO
	GET
	TAD [-214]	/CHAR AFTER LINE FEED A FORM FEED?
	SNA
	JMP FFEED	/YES, GO TO FORM FEED ROUTINE
	TAD [214]	/NO, RESTORE CHAR TO ACC
	DCA UASCII
	JMS BBREAK	/OUTPUT PAGE BREAK
	TAD OPTWD1
	AND [10]	/LOOK FOR OPTION CHAR "I"
	SZA CLA
	INC PAGEN	/IF /I, INCREMENT PAGE#
	JMP XPUTC1	/GO OUTPUT TITLE AND CHECK CHAR

LFEED4,	JMS BBREAK	/DO BOTTOM OF PAGE BREAK

LFEED3,	CLA IAC
	DCA CHARCT	/INITIALIZE CHAR COUNTER TO 1
	TAD (TABTAB)
	DCA POINT	/TAB TABLE POINTER
	TAD OPTWD2
	AND (20)	/CHECK FOR OPTION /T
	SNA CLA
	JMP XPUTCR	/NO SPACES EITHER
	TAD PAGEN	/OUTPUTTING LARGE LETTERS?
	SPA SNA CLA
	JMP XPUTCR	/NO, NO LEADING SPACES
	TAD LEFTAB	/YES, /T SPECIFIED
	DCA NSPACE	/USE AS LEFT MARGIN
	JMP I XPUTC	/RETURN TO CALLER

FFEED1,	TAD TOPSW	/AT TOP OF PAGE?
	SZA CLA
	JMP LFEED3	/YES, RESET SOM E PARMS
	DCA PAGEP	/RESET PARTIAL PAGE# TO 0
	JMS BBREAK	/OUTPUT BOTTOM OF PAGE BREAK
	INC PAGEN	/INCREMENT PAGE#
	NOP
	STA
	DCA TOPSW	/MUST OUTPUT TOP OF PAGE BREAK
	DCA CRSWIT
	JMP LFEED3

CARRET,	ISZ CRSWIT	/OUTPUT THE CARRIAGE RETURN?
	JMP LFEED3	/NO, GO START NEW LINE
	TAD [215]	/YES, OUTPUT IT
	PUT
	JMP LFEED3

SPACE,	INC NSPACE	/INCREMENT NO. OF SPACES
	JMS LCHECK	/CHECK LINE OVERFLOW
	JMP I XPUTC

INCTAB,	CLA
	INC POINT	/POINT TO NEXT TAB POSITION
OUTTAB,	TAD CHARCT
	TAD I POINT
	SMA
	JMP INCTAB	/NOT YET TO TAB POSITION
	DCA COUNT	/SAVE COUNT TO TAB POSITION
	INC NSPACE	/"OUTPUT" A SPACE
	JMS LCHECK	/CHECK LINE OVERFLOW
	ISZ COUNT
	JMP .-3
	JMP I XPUTC

/ SUBROUTINE TO BOTTOM OF PAGE BREAK

BBREAK,	0
	TAD PAGEB	/OUTPUT "BOTTOM OF PAGE" BREAK?
	TAD TTYSWT
	SZA CLA
	JMP PUTFF	/NO, JUST OUTPUT A FORM FEED
	TAD LINECT
	JMS PUTLF	/GO TO BOTTOM OF PAGE
	TAD BOT
	JMS PUTLF	/OUTPUT "BOT" LINE FEEDS
	JMS BREAK	/OUTPUT 6 "-"
PUTFF,	TAD [214]	/OUTPUT FORM FEED
	PUT
	DCA LINECT	/CLEAR LINECT
	JMP I BBREAK

PAGE
GETMESS, 0
	CLA CLL
	TAD (TYPE)
	DCA OUTIT	/OUTPUT TO TELETYPE IN SUBR. "TYPMESS"
	TCRLF
	TAD I GETMESS
	INC GETMESS
	DCA .+2
	JMS TYPMESS	/OUTPUT THE MESSAGE TO USER
	 0
	TAD (TITLEM)
	DCA POINT	/POINT TO CURRENT CHAR POISITION
	DCA I POINT
	TAD (-77)
	DCA COUNT	/NO. OF CHARS IN BUFFER
	DCA RUBFLG	/NO RUBOUT YET

TITLIN,	JMS KBDIN	/GET A KEYBOARD CHAR
	TAD (-377)
	SNA
	JMP RUBOUT	/RUBOUT, DELETE ONE CHAR
	TAD (377-215)
	SNA
	JMP ENDTIT	/CARRIAGE RETURN, END THE TITLE
	TAD (215-212)
	SNA
	JMP ECHOIT	/LINE FEED, ECHO THE TITLE
	TAD (212-225)
	SNA
	JMP CTRLU	/CTRL/U, DELETE ENTIRE LINE
	TAD (225)	/REGENERATE THE CHAR
	DCA I POINT
	TAD RUBFLG	/PROCESSING A RUBOUT?
	SNA CLA
	JMP TITL2	/NO
	TAD ("\)	/YES, FIRST OUTPUT A BACKSLASH
	TYPE
	DCA RUBFLG	/NO RUBOUTS NOW
TITL2,	TAD I POINT
	TYPE
	INC POINT	/INCREMENT POINTER FOR NEXT CHAR
	DCA I POINT	/A ZERO INDICATES EOM
	ISZ COUNT	/IS BUFFER FULL?
	JMP TITLIN	/NO, GET NEXT CHAR

ENDTIT,	TCRLF
	TAD (PUT)	/RESET FOR SYSTEM PUT
	DCA OUTIT
	JMP I GETMESS

CTRLU,	TAD ("^)	/ECHO "^U"
	TYPE
	TAD ("U)
	TYPE
	JMP GETMESS+1	/GET NEW LINE

TYPEIT,	0
	TLS
	TSF
	JMP .-1
	TCF
	CLA CLL
	JMP I TYPEIT

RUBOUT,	TAD POINT
	TAD (-TITLEM)	/AT START OF BUFFER?
	SNA CLA
	JMP TITLIN	/YES, DO NOT ECHO
	TAD RUBFLG	/FIRST RUBOUT?
	SZA CLA
	JMP .+3		/NO
	TAD ("\)	/YES, ECHO A BACKSLASH
	TYPE
	STA
	DCA RUBFLG	/NOW PROCESSING A RUBOUT
	STA
	TAD POINT
	DCA POINT	/DECREMENT BUFFER POINTER BY ONE
	TAD I POINT	/ECHO CHAR JUST DELETED
	TYPE
	DCA I POINT	/ZERO TO INDICATE EOM
	STA
	TAD COUNT
	DCA COUNT	/DECREMENT COUNTER, TOO
	JMP TITLIN	/GET CHARS FOR TITLE

RUBFLG,	0


ECHOIT,	TCRLF
	JMS TYPMESS
	 TITLEM
	JMP TITLIN

KBDIN,	0
	KSF
	JMP .-1
	KRS
	TAD (-203)
	SNA CLA
	JMP I [7600]	/CTRL/C, RETURN TO SYSTEM
	KRB		/RESTORE CHAR TO ACC
	JMP I KBDIN	/RETURN WITH CHAR IN ACC

TYPMESS, 0
	STA
	TAD I TYPMESS
	INC TYPMESS
	DCA 11
	TAD I 11
	SNA
	JMP I TYPMESS
OUTIT,	PUT
	JMP .-4

EXTBUF,	ZBLOCK	7

PAGE
/ SUBROUTINE TO OUTPUT A CHAR TO OUTPUT FILE
/ CHECK TO SEE IF WE ARE LISTING THIS PAGE

OUTPUT,	0
	DCA CHAR	/SAVE THE CHAR
	KSF
	JMP OUTQ	/KEY NOT STRUCK, GO OUTPUT PAGE
	KRS		/READ IN CHAR
	TAD (-203)
	SNA CLA
	JMP I [7600]	/CTRL/C, RETURN TO SYSTEM
	KCC		/CLEAR FLAG

OUTQ,	TAD PAGEN	/IS PAGE # <= 0 ?
	SPA SNA CLA
	JMP OUTQIT	/YES, GO OUTPUT CHAR
	TAD (PAGTAB-1)	/NO, CHECK PAGE TABLE
	DCA 17
	TAD (-30)
	DCA OUTQCT	/SET UP COUNTER
OUTQ1,	TAD I 17	/FIRST OF PAIR OF PAGE NUMBERS
	SNA
	JMP I OUTPUT	/END OF TABLE, NOT PRINTING THIS PAGE
	CIA
	TAD PAGEN
	SPA CLA		/PAGE # < FIRST NUM?
	JMP I OUTPUT	/YES, NOT PRINTING THIS PAGE
	TAD I 17	/2ND OF PAIR
	CIA
	TAD PAGEN
	SMA SZA CLA	/PAGE # > SECOND NUM?
	JMP OUTQ1	/YES, MAYBE ANOTHER PAIR TO CHECK
OUTQIT,	TAD CHAR	/O.K. TO OUTPUT THE CHAR
	PUTIT		/YES, OUTPUT THE CHAR
	JMP I OUTPUT

OUTQCT,	0

/ SUBROUTINE TO OUTPUT TOP OF PAGE BREAK

TBREAK,	0
	TAD PAGEB	/OUTPUT A PAGE BREAK?
	SZA CLA
	JMP NOBREAK	/NO, GO RESET LINE COUNTER
	TAD OPTWD1	/ARE WE DOING AN ASM LISTING (/A) ?
	SPA CLA
	JMP ASMBRK	/YES
	TAD TP1		/GET MARGIN FROM TOP
	JMS PUTLF	/OUTPUT "TOPM" LINE FEEDS
	TAD PAGEN
	SPA SNA CLA	/IS PAGE # <= 0 ?
	JMP FBRK2	/YES, NO TITLE
	TAD TITLEQ	/OUTPUT TITLE LINE?
	SZA CLA
	JMP FBREAK	/NO, GO FINISH THE BREAK
	TAD LEFTAB	/YES
	DCA NSPACE	/INITIALIZE NO. OF SPACES ON LINE
	TAD NSPACE
	SNA
	JMP TBRK2	/NO LEFT MARGIN
	CIA
	DCA STARCT	/USE CTR FOR NO. OF LEADING SPACES
	TAD [" ]
	PUT
	ISZ STARCT
	JMP .-3
TBRK2,	JMS TYPMESS	/YES, OUTPUT PAGE#
	 PAGEM
	TAD PAGEN
	JMS OCTDEC	/OUTPUT PAGE NUMBER
	TAD OPTWD1
	AND [10]	/LOOK FOR OPTION CHAR "I"
	SZA CLA
	JMP NOPART	/IF /I, ONLY LIST PAGE NO. (INTEGER)
	TAD [".]	/OTHERWISE, WANT PARTIAL PAGE, TOO
	PUT
	INC PAGEP	/INCREMENT PARTIAL PAGE#
	TAD PAGEP
	JMS OCTDEC	/OUTPUT THE PARTIAL PAGE#
NOPART,	JMS TYPMESS	/OUTPUT 2 SPACES
	 SPACE2
	JMS TYPMESS	/OUTPUT THE TITLE
	 TITLEM
	TAD [DATBUF-2-1] /NO, PREPARE TO OUTPUT DATE
	DCA 10
FBRK1,	TAD I 10
	SNA
	JMP FBRK2
	PUT
	JMP FBRK1
FBRK2,	TAD [215]
	PUT
FBREAK,	TAD OPTWD1
	SPA CLA		/SKIP IF NOT /A
	CLL STA RAL	/SET AC = -2
	TAD BDY
	DCA LINECT
	TAD OPTWD1	/SKIP IF NOT /A
	SPA CLA
	STL RTL		/SET AC=2
	TAD TP2
	JMS PUTLF	/OUTPUT THE LINE FEEDS
FBRK4,	DCA TOPSW	/NO LONGER AT TOP OF PAGE
	JMP I TBREAK

ASMBRK,	CLL STA RAL	/-2 TO ACC
NOBREAK, TAD BDY
	DCA LINECT	/RESET LINE COUNT
	JMP FBRK4

STARSV,	0
	DCA 10		/ADDR OF BUFFER TO SAVE STARS
	TAD [-6]	/NO. OF ASTERISKS TO SAVE
	DCA STARCT
	TAD ["*]
	DCA I 10	/SAVE IN APPROPRIATE BUFFER
	ISZ STARCT
	JMP .-3
	DCA I 10	/0 ENDS THE BUFFER
	JMP I STARSV

STARCT,	0

NAMBUF,	ZBLOCK	7

PAGE
/
/ FORM FEED HAS BEEN INPUT
/ IF IT IS AN ASSEMBLY LISTING,
/ THEN "READ" THE PAL-8 OR PAL-12
/ PAGE NUMBER FROM THE HEADING
/
FFEED,	TAD OPTWD1	/IS THIS AN ASSEMBLY LISTING?
	SMA CLA
	JMP FFEED1	/NO, REGULAR FORM FEED
	TAD PAGEN
	SPA SNA CLA	/PRINTING REGULAR LISTING?
	JMP FFEED1	/NO
	JMS BBREAK	/OUTPUT BOTTOM OF PAGE BREAK
	STA
	DCA TOPSW	/TOP OF PAGE BREAK
	TAD (-73)
	DCA COUNT	/NO. OF CHARS TO PAL8 OR PAL12 PAGE#
	TAD (ASMBUF-1)	/LOC TO SAVE THEM
	DCA 10
	GET
	DCA I 10	/SAVE CHARS IN BUFFER
	ISZ COUNT
	JMP .-3
	GET		/NOW HUNT FOR EOL
	TAD [-215]
	SNA
	JMP .+4
	TAD [215]
	DCA I 10	/OTHERWISE SAVE CHARS
	JMP .-6		/AND GET SOME MORE
	DCA I 10	/IF EOL, END BUFFER WITH 0
	TAD (ASMBUF+73-1)
	DCA 10
	JMS ASCBIN	/GET THE PAGE NUMBER
	CLA		/IGNORE CHAR THAT ENDED IT
	TAD NUMBER
	DCA PAGEN	/SAVE THE PAGE NUMBER
	DCA CRSWIT
	TAD TTYSWT	/OUTPUTTING TO TTY?
	SZA CLA
	JMP .+5		/NO
	TAD [212]	/YES, OUTPUT A COUPLE OF LINE FEEDS
	PUT
	TAD [212]
	PUT
	TAD (ASMBUF-1)
	DCA 10		/PREPARE TO OUTPUT THE TITLE LINE
	TAD I 10
	SNA
	JMP .+3		/0, END OF LINE; CONTINUE WITH CR/LF
	PUT
	JMP .-4		/CONTINUE TO OUTPUT HEADING
	ISZ LINECT	/DOES NOT SKIP OUT
	JMP CARRET+2	/OUTPUT CR, THEN GET LINE FEED

ASCBIN,	0
	CLA CLL
GETNUM,	DCA NUMBER	/UPDATE THE NUMBER
	TAD I 10	/GET AN ASCII CHAR FROM BUFFER
	SNA
	JMP I ASCBIN	/ZERO INDICATES END OF INPUT LINE
	TAD (-272)
	SPA
	JMP .+3
	TAD (272)
	JMP I ASCBIN	/NOT DIGIT, RET WITH CHAR IN ACC
	TAD (272-260)
	SMA
	JMP .+3
	TAD ["0]
	JMP I ASCBIN	/NOT DIGIT, RET WITH CHAR IN ACC
	DCA TEMP	/SAVE DIGIT
	TAD NUMBER	/10X = (4X + X) * 2
	CLL RTL
	TAD NUMBER
	CLL RAL
	TAD TEMP	/ADD IN CURRENT DIGIT
	JMP GETNUM	/UPDATE NUMBER

SETUPL,	0
	CIF 10
	JMS I (SETUP)
	  0		/NO EXTENSION
	  ENDATA	/END-OF-FILE ROUTINE
	TAD [DATBUF-1]
	DCA 10
	CDF 10
	TAD I (MDATE)	/GET SYSTEM DATE
	CDF 00
	SNA
	JMP SETUP3	/NO, DATE GIVEN, FILL WITH "***"
	DCA SETUPT	/SAVE THE DATE
	TAD SETUPT
	CLL RTL; RTL; RAL
	JMS DATECV
	TAD SETUPT
	RTR; RAR
	JMS DATECV	/SAVE DAY PART
	TAD ["7]
	DCA I 10
	TAD SETUPT
	AND [7]
	TAD ["0]
	DCA I 10	/SAVE YEAR
	JMP SETUP5

SETUP3,	TAD [-10]
	DCA SETUPC
	TAD ["*]
	DCA I 10	/FILL BUFFER WITH STARS
	ISZ SETUPC
	JMP .-3

SETUP5,	DCA I 10	/0 ENDS THE BUFFER
	JMS SETNAM	/FIX UP FILENAME AND EXTENSION
	JMP I SETUPL

SETUPT,	0
SETUPC,	0

PAGE
INPUT,	0
	GETIT		/GET AN INPUT CHAR
	AND (177)	/CHECK 7 BIT ASCII
	SZA
	TAD (-177)	/CHECK FOR RUBOUT
	SNA
	JMP INPUT+1	/IGNORE ZERO AND RUBOUT CODES
	TAD (177+200)	/RESTORE CHAR TO ACC
	JMP I INPUT

	DECIMAL
ADHSET,	0		/RESET MARGINS FOR ADH
	TAD (-6-MARTP1)
	DCA TP1
	TAD (-0-MARTP2)
	DCA TP2
	TAD (+6+0-BODY)
	DCA BDY
	JMP I ADHSET
	OCTAL

/ ASCII STRINGS FOR TYPOUTS

ENTITL,	ASCII	"ENTER TITLE"
	215; 212; 0

ENTPAG,	ASCII	"ENTER PAGES"
	215; 212; 0

ENTABV,	ASCII	"ENTER VARIABLE TABS"
	215; 212; 0

ENTABF,	ASCII	"ENTER FIXED TAB"
	215; 212; 0

ENTABT,	ASCII	"ENTER LEFT TAB"
	215; 212; 0

PAGEM,	ASCIIZ	"PAGE  "

SPACE2,	240;240;0

LISTM,	ASCII	"LIST V"
	VERSION; 215; 212; 0

PAGE
/ SUBROUTINE TO PRINT OUT THE FILE NAME AND EXTENSION
/ IN LARGE LETTERS, ALSO THE SYSTEM DATE

LARGE,	0
	TAD [-10]
	JMS LFOUT	/OUTPUT 8 LINE FEEDS
	JMS LARGEO	/OUTPUT THE NAME
	  NAMBUF
	  7777
	TAD I (EXTBUF)
	SNA CLA		/ANYTHING IN EXTENSION BUFFER?
	JMP LARGE2	/NO
	TAD (-4)	/YES
	JMS LFOUT	/FIRST, OUTPUT 4 LINE FEEDS
	JMS LARGEO	/THEN OUTPUT THE ENTENSION
	  EXTBUF
	  7777
LARGE2,	TAD [-6]
	JMS LFOUT	/OUTPUT SOME MORE BLANK LINES
	JMS LARGEO	/THEN OUTPUT THE DATE
	  DATBUF
	  0000
	JMP I LARGE	/RETURN TO CALLER

/ MAIN SUBROUTINE TO USE PATTERN WORDS TO OUTPUT LARGE CHARS

LARGEO,	0
	TAD I LARGEO
	INC LARGEO
	DCA LARGPT	/POINTS TO OUTPUT BUFFER
	TAD I LARGEO
	INC LARGEO
	DCA LARGSW	/THE SWITCH FOR EXTRA LARGE OR LARGE
	TAD [-6]
	DCA LGCTR1	/NO. OF LINES PER CHAR
	DCA LGWORD	/1ST OF 3 PATTERN WORDS
	DCA LGHALF	/START IN LEFT HALF

LARGA,	TAD LARGSW	/EXTRA LARGE LETTERS?
	CLL RAL		/MAKE 7777 A 7776 (-2)
	SNL		/ANSWER IN LINK BIT
	STA		/NO, JUST 1 LINE
	DCA LARGCT	/SAVE THE CTR
LARG0,	TAD LARGPT
	DCA LGPTR1	/POINTS TO CHARS TO OUTPUT
LARG1,	TAD I LGPTR1	/GET A CHAR
	SNA
	JMP LARG5	/END OF LINE
	TAD [-240]
	DCA LGTMP	/FOR INDEX INTO TABLE
	TAD LGTMP
	CLL RAL
	TAD LGTMP
	TAD (PWORDS)	/PATTERNS IN FIELD 1
	TAD LGWORD	/CURRENT WORD OF 3-WORD GROUP
	DCA LGPTR2
	TAD LGHALF	/WHICH HALF TO DO?
	SNA CLA
	JMP LGLEFT	/0, LEFT HALF
	CDF 10		/7777, RIGHT HALF
	TAD I LGPTR2	/GET A PATTERN WORD FROM FIELD 1
	CDF 00
	CLL RTL; RTL; RTL
	JMP LARG2

LGLEFT,	CDF 10
	TAD I LGPTR2
	CDF 00
LARG2,	AND (7700)	/JUST WANT GOOD PART
	DCA LGTMP
	TAD [-6]	/NO. OF BITS TO PROCESS
	DCA LGCTR2
LARG3,	TAD LGTMP
	CLL RAL
	DCA LGTMP
	SNL		/PRINT THE CHAR?
	JMP .+3		/NO, PRINT A SPACE
	TAD I LGPTR1	/YES, GET THE CHAR TO PRINT
	SKP
	TAD [" ]
	DCA LGCHAR	/SAVE CHAR TO PRINT
	TAD LGCHAR
	PUTC
	TAD LARGSW	/EXTRA LARGE CHARS?
	SNA CLA
	JMP .+3		/NO
	TAD LGCHAR	/YES, OUTPUT IT AGAIN
	PUTC
	ISZ LGCTR2	/ALL CHARS ACROSS FOR THIS ONE?
	JMP LARG3	/NO, GET NEXT BIT
	TAD [" ]
	PUTC		/OUTPUT A SPACE
	TAD LARGSW	/ARE WE DOING REGULAR LARGE?
	SZA CLA
	JMP LARG4	/NO, EXTRA LARGE, NO MORE SPACES
	TAD [" ]
	PUTC
	TAD [" ]
	PUTC
LARG4,	INC LGPTR1	/NEXT CHAR ON LINE
	JMP LARG1

LARG5,	TAD [215]	/OUTPUT CR/LF COMBO
	PUTC
	TAD [212]
	PUTC
	ISZ LARGCT	/ENOUGH LINES OUT?
	JMP LARG0	/NO, GO DO NEXT LINE
	TAD LGHALF	/END OF LINE
	CMA
	DCA LGHALF	/COMPLEMENT HALF SWITCH
	TAD LGHALF	/ARE WE ON A NEW WORD?
	SNA CLA
	INC LGWORD	/YES, POINT TO LEFT HALF OF NEXT WORD
	ISZ LGCTR1	/6 LINES DONE?
	JMP LARGA	/NO, DO ANOTHER LINE
	JMP I LARGEO	/YES, RETURN

LARGPT,	0
LARGSW,	0
LGCTR1,	0
LGCTR2,	0
LGHALF,	0
LGPTR1,	0
LGPTR2,	0
LGTMP,	0
LGCHAR,	0
LGWORD,	0
LARGCT,	0

PAGE
/ SUBROUTINE TO GET FILENAME AND EXTENSION
/ AND PUT IN BUFFERS FOR LARGE CHARACTER OUTPUT

SETNAM,	0
	CLA CLL
	DCA I [NAMBUF]
	DCA I [EXTBUF]
	TAD [TITLEM-1]	/USED AS TEMP FOR SAVING CHARS
	DCA 10
	TAD (7601)
	DCA SETPTR	/POINTS TO CURRENT NAME
	DCA SETHLF	/START IN LEFT HALF
	STA CLL RTL	/-3 TO ACC
	DCA SETCTR	/3 WORDS TO NAME
	DCA SETCNT	/NO. OF CHARS IN NAME AND EXT

SETN2,	CDF 10
	TAD I SETPTR	/GET 2 CHARS
	CDF 00
	ISZ SETHLF	/WHICH HALF?
	JMP SETLFT	/LEFT HALF FIRST
	JMS SETSAV	/RIGHT HALF, SAVE IN LINE BUFFER
	INC SETPTR	/POINT TO NEXT CHARS
	ISZ SETCTR	/NAME DONE?
	JMP SETN2	/YES
	CDF 10
	TAD I SETPTR	/NOW CHECK EXTENSION
	CDF 00
	SNA
	JMP SETN4	/NO EXTENSION
	DCA SETEMP	/SAVE THE EXTENSION
	TAD [".]
	DCA I 10	/. COMES BEFORE EXTENSION
	INC SETCNT	/ANOTHER CHAR IN LINE BUFFER
	TAD SETEMP
	CLL RTR; RTR; RTR
	JMS SETSAV	/SAVE LEFT CHAR
	TAD SETEMP
	JMS SETSAV	/AND RIGHT CHAR

SETN4,	DCA I 10	/0 ENDS THE BUFFER
	TAD I (TITLEM)
	SNA CLA
	JMP SETN5	/NOTHING IN FILE NAME
	TAD [NAMBUF-1]
	DCA 10		/SAVE IN NAME BUFFER, FIRST
	TAD SETCNT
	TAD [-6]	/<= 6 CHARS IN NAME BUFFER?
	SMA SZA
	JMP SETN7	/> 6, SOMETHING SPECIAL
	SMA
	JMP SETN6	/=6, JUST SAVE ALL CHARS
	STL RAR
	SZL
	IAC
	SNA
	JMP SETN6	/NO LEADING SPACES
	DCA SETCNT	/SAVE THE COUNTER
	TAD [" ]
	DCA I 10
	ISZ SETCNT	/ENOUGH SPACES YET?
	JMP .-3

SETN6,	TAD [TITLEM-1]
	DCA 11
	TAD I 11
	SNA
	JMP .+3
	DCA I 10	/MOVE CHARS TO NAME BUFFER
	JMP .-4
	DCA I 10	/AGAIN, 0 ENDS THE BUFFER
SETNMR,	JMP I SETNAM	/RETURN TO CALLER

SETLFT,	CLL RTR; RTR; RTR
	JMS SETSAV	/SAVE THE LEFT HALF
	STA
	DCA SETHLF	/RIGHT HALF NEXT TIME
	JMP SETN2

SETN5,	TAD [NAMBUF-1]
	JMS STARSV	/FILL NAME BUFFER WITH STARS
	TAD [EXTBUF-1]	/DITTO EXTENSION BUFFER
	JMS STARSV
	JMP I SETNAM

SETHLF,	0
SETCTR,	0
SETCNT,	0
SETPTR,	0
SETEMP,	0

/ SUBROUTINE TO CHECK FOR SPECIAL ASSEMBLER LISTING FLAGS

ASMSET,	0
	CLA CLL
	TAD OPTWD1	/A OPTION GIVEN?
	SMA CLA
	JMP I ASMSET	/NO, RETURN TO CALLER
	CLA IAC
	AND OPTWD2	/CHECK FOR /X OPTION
	SNA CLA
	JMP I ASMSET	/NO, JUST RETURN
	TAD (TABTAB)	/YES, USE PRESET TABS
	DCA POINT
	TAD (-204)	/132 DECIMAL
	DCA COUNT
	TAD (-6)
	DCA I POINT	/START AS IF COL 3
ASMST1,	TAD [-10]	/AND EVERY 10TH (8TH) COL AFTER
	TAD I POINT
	INC POINT
	DCA I POINT
	ISZ COUNT
	JMP ASMST1
	JMP I ASMSET	/RETURN TO CALLER

PUTLF,	0
	SNA
	JMP I PUTLF	/IF ZERO, RETURN
	DCA COUNT	/SAVE COUNTER
	TAD [212]
	PUT
	ISZ COUNT
	JMP .-3
	JMP I PUTLF

PAGE
/ CONTINUATION OF SETNAM SUBROUTINE

SETN7,	CLA
	DCA SETCNT	/CTR FOR NO. OF CHARS AS WE LOOK
	TAD [TITLEM-1]
	DCA 11		/LOOK AT THE BUFFER LINE AGAIN
SETN8,	TAD I 11
	INC SETCNT	/COUNT THE CHAR
	SNA
	HLT		/SHOULD NEVER HALF
	TAD [-".]
	SZA CLA
	JMP SETN8	/NOT PERIOD, LOOK AGAIN
	TAD SETCNT	/IS PERIOD, IN 5TH POSITION?
	TAD (-5)
	SZA CLA
	JMP .+3
	TAD [" ]	/YES, OUTPUT A LEADING SPACE
	DCA I 10
	TAD [TITLEM-1]
	DCA 11		/PREPARE TO MOVE THE NAME
SETN81,	TAD I 11
	SNA
	HLT		/SHOULD NEVER HAPPEN
	TAD [-".]	/IS CHAR A PERIOD?
	SNA
	JMP SETN9	/YES
	TAD [".]	/NO, REGENERATE CHAR
	DCA I 10	/AND SAVE IT
	JMP SETN81

SETN9,	DCA I 10	/0 ENDS THE NAME BUFFER
	TAD [EXTBUF-1]
	DCA 10		/NOW TO MOVE EXTENSION
	TAD [" ]	/ALWAYS 2 LEADING SPACES
	DCA I 10
	TAD [" ]
	DCA I 10
	TAD I 11	/MOVE THE CHARS INTO EXTENSION
	DCA I 10
	TAD I 11
	DCA I 10
	TAD I 11
	DCA I 10
	JMP SETNMR	/RETURN TO CALLER

/ SAVE A CHAR IN A BUFFER AND COUNT IT

SETSAV,	0
	AND [77]
	SNA
	JMP I SETSAV	/IGNORE 0 CODE
	TAD [" ]
	AND [77]
	TAD [" ]
	DCA I 10
	INC SETCNT
	JMP I SETSAV

/ SUBROUTINE USED IN DATE CONVERSION

DATECV,	0
	AND (37)
	DCA DATET1
	DCA DATET2
	JMP .+3
	ISZ DATET2
	DCA DATET1
	TAD DATET1
	TAD (-12)
	SMA
	JMP .-5
	CLA
	TAD DATET2
	SNA
	JMP .+3
	TAD ["0]
	DCA I 10
	TAD DATET1
	TAD ["0]
	DCA I 10
	TAD ("/)
	DCA I 10
	JMP I DATECV

DATET1,	0
DATET2,	0

	240; 240	/THESE SPACES MUST BE BEFORE 'DATBUF'
DATBUF,	ZBLOCK	12

LCHECK,	0
	INC CHARCT	/INCREMENT CHARACTER CTR
	TAD CHARCT
	TAD LINSIZ	/END OF OUTPUT LINE?
	SPA CLA
	JMP I LCHECK	/NO, RETURN
	TAD OPTWD1	/YES, END THE LINE HERE?
	RTL		/CHECK FOR /C OPTION CHAR
	SMA CLA
	JMP I LCHECK	/NO, RETURN
	TAD [215]	/YES, OUTPUT CARRIAGE RETURN
	PUT
	JMP LFEED	/THEN OUTPUT LINE FEED

/ TELL USER WHO WE ARE

WHOQ,	0
	CLA CLL
	TAD (TYPE)
	DCA OUTIT	/OUTPUT DEV IS TELETYPE
	JMS TYPMESS	/OUTPUT THE MESSAGE
	  LISTM		/"LIST VN"
	TAD (PUT)
	DCA OUTIT	/RESET OUTPUT ROUTINE
	JMP I WHOQ

PAGE
/ START OF PS/8 LISTING PROGRAM
/ ACTUAL LISTING PART OF LISTER

START,	STA
	DCA LINECT	/INTIIALIZE LINES/PAGE CTR
	DCA TOPSW	/ZAP TOP OF PAGE SWITCH
	DCA PAGEN	/PAGE # = 0000
	DCA PAGEP	/PARTIAL PAGE # = 0, TOO
	TAD [214]	/YES, OUTPUT TO TOP OF PAGE
	PUTC
STARTL,	CLA IAC
	DCA PAGEN	/INITIALIZE PAGE #
	DCA PAGEP	/AND PART PAGE
	JMS ASMSET	/SET UP FOR ASSEMBLY OUTPUT (MAYBE)
	TAD OPTWD1
	DCA ASMTMP	/SAVE /A SWITCH A SEC
	TAD TTYSWT	/OUTPUT TO TELETYPE?
	SNA CLA
	JMP START1	/YES
	CLL STA RAR	/3777 TO ACC
	AND OPTWD1
	DCA OPTWD1	/GET RID OF /A OPTION FOR NOW
	TAD LSWIT	/OUTPUT LARGE LETTERS?
	SZA CLA
	JMP START1	/NO
	DCA PAGEN	/YES, SO ZAP PAGE #
	JMS LARGE	/OUTPUT NAME IN LARGE LETTERS
	TAD [214]	/OUTPUT TO BOTTOM OF PAGE
	PUTC
START1,	TAD ASMTMP	/RESET /A OPTION
	DCA OPTWD1
	TAD OPTWD1	/CHECK FOR /A OPTION
	SMA CLA
	JMP START2	/NOT, GO START LIST
	TAD TTYSWT	//A, NOW SET PAGE #
	SZA CLA		/OUTPUT TO TTY?
	CLL STA RAR	/NO, SET PAGE # = 3777
	DCA PAGEN	/YES, SET PAGE # TO 0

START2,	GET		/GET AN INPUT CHAR
	PUTC		/OUTPUT THE CHAR
	JMP START2	/KEEP IN LOOP

ASMTMP,	0

/ END OF DATA PROCEDURE

ENDATA,	STA
	DCA PAGEN	/ALLOW NO HEADING ON LAST PAGES
	TAD OPTWD1
	DCA OPTWDE	/SAVE OPT WD 1 A SEC
	CLL STA RAR	/3777 TO ACC
	AND OPTWD1	/GET RID OF /A OPTION
	DCA OPTWD1
	TAD TOPSW	/ARE WE AT TOP OF PAGE?
	SZA CLA
	JMP .+3		/YES
	TAD [214]	/LAST PAGE BREAK
	PUTC
	DCA PAGEN	/NO TOP OF PAGE TITLE HEADING

ENDAT1,	TAD LSWIT	/OUTPUT LARGE LETTERS?
	SZA CLA
	JMP ENDAT2	/NO
	JMS LARGE	/OUTPUT END LARGE LETTERS
	TAD [214]
	PUTC
ENDAT2,	TAD OPTWDE	/RESET OPTWD1
	DCA OPTWD1
	ISZ NCOPY	/ALL COPIES OUT?
	JMP ENDAT3	/NO
	TAD TTYSWT	/OUTPUT TO TELETYPE?
	SZA CLA
	JMP ENDAT4	/NO, CLOSE FINAL OUTPUT
	TAD [212]	/OUTPUT A COUPLE MORE LINE FEEDS
	PUTC
	TAD [212]
	PUTC
ENDAT4,	CLOSE		/CLOSE OUTPUT FILE
	JMP BEGIN	/ASK FOR MORE INPUT

ENDAT3,	CIF 10		/WE WANT MORE COPIES, SO
	JMS I (IOPEN)	/REOPEN INPUT FILES
	JMP STARTL	/AND GO AGAIN

OPTWDE,	0

/ CONVERT NUMBER IN AC TO DECIMAL

OCTDEC,	0
	DCA ODNUM	/SAVE NUM TO CONVERT
	STA
	DCA LZERO	/SET LEADING ZERO SWITCH
	TAD (DIGTAB-1)
	DCA OCTEMP
	CLL STA RTL	/-3 TO ACC
	DCA DIGCTR	/NO. OF DIGITS BEFORE PRINTING LAST
OD1,	INC OCTEMP
	DCA DIGIT	/CLEAR OUT DIGIT
OD2,	TAD ODNUM
	TAD I OCTEMP	/CHECK WITH POWER OF TEN
	SPA
	JMP OD3
	INC DIGIT	/INCREMENT DIGIT IF POSITIVE
	DCA ODNUM	/SAVE DIFFERENCE
	JMP OD2
OD3,	CLA
	TAD DIGIT
	SNA
	JMP LEADZ	/IS IT A LEADING ZERO?
OD4,	TAD ["0]	/NO, CONVERT TO ASCII CHAR
	PUT		/OUTPUT THE CHAR
	DCA LZERO	/NO MORE LEADING ZEROES
OD5,	ISZ DIGCTR	/3 DIGITS OUT?
	JMP OD1
	TAD ODNUM	/YES, OUTPUT LAST DIGIT
	TAD ["0]
	PUT
	JMP I OCTDEC	/RETURN TO CALLER
LEADZ,	TAD LZERO
	SZA CLA
	JMP OD5
	JMP OD4

PAGE
TITLEM=.
TABTAB=TITLEM+100
PAGTAB=TABTAB+206
DOT=PAGTAB+100
ASMBUF=3400

	OUBUF=3600	/OUTPUT BUFFER IN FIELD 0
	OUCTL=1400!4000	/6 RECORDS IN BUFFER (3000 WORDS)
	OUDEVH=7200	/2-PAGE OUTPUT HANDLER

	INBUF=0000	/INPUT BUFFER IN FIELD 1
	INCTL=2010	/8 RECORDS IN BUFFER (4000 WORDS)
	INRECS=INCTL%200
	INDEVH=6600	/2-PAGE INPUT HANDLER

	MDATE=7666	/IN FIELD 1

	FIELD 1		/DUMP PAGE ZERO LITERALS
/ PATTERN WORDS FOR 6X6 CHARACTER MATRIX

*7300

PWORDS,

0000; 0000; 0000 /40: SPACE
1010; 1010; 0010 /41: !
2424; 0000; 0000 /42: "
2476; 2424; 7624 /43: #
3744; 3611; 1176 /44: $
6162; 0410; 2343 /45: %
1422; 1421; 4235 /46: &
1010; 0000; 0000 /47: '
1420; 2020; 2014 /50: (
1402; 0202; 0214 /51: )
4224; 7624; 4200 /52: *
0010; 1076; 1010 /53: +
0000; 0014; 0410 /54: ,
0000; 0076; 0000 /55: -
0000; 0000; 1414 /56: .
0102; 0410; 2040 /57: /
3643; 4551; 6136 /60: 0
0414; 0404; 0437 /61: 1
3442; 0410; 2076 /62: 2
3442; 0402; 4234 /63: 3
0414; 2477; 0404 /64: 4
7640; 7601; 4136 /65: 5
0204; 1034; 4234 /66: 6
7702; 0410; 2040 /67: 7
1422; 1422; 4136 /70: 8
1621; 1604; 1020 /71: 9
0014; 1400; 1414 /72: :
1414; 0014; 0410 /73: ;
0410; 2010; 0400 /74: <
0000; 7600; 7600 /75: =
1004; 0204; 1000 /76: >
3442; 0410; 0010 /77: ?

3641; 5556; 4037 /100: @
3641; 7741; 4141 /101: A
7641; 7641; 4176 /102: B
3641; 4040; 4136 /103: C
7641; 4141; 4176 /104: D
7740; 7640; 4077 /105: E
7740; 7640; 4040 /106: F
3641; 4047; 4136 /107: G
4141; 7741; 4141 /110: H
3410; 1010; 1034 /111: I
0702; 0202; 2214 /112: J
4450; 6050; 4442 /113: K
4040; 4040; 4077 /114: L
4163; 5541; 4141 /115: M
4161; 5145; 4341 /116: N
7741; 4141; 4177 /117: O
7641; 7640; 4040 /120: P
3641; 4145; 4337 /121: Q
7641; 7644; 4241 /122: R
3640; 3601; 4136 /123: S
7610; 1010; 1010 /124: T
4141; 4141; 4136 /125: U
4141; 4142; 2410 /126: V
4141; 4155; 6341 /127: W
4122; 1414; 2241 /130: X
4122; 1410; 2040 /131: Y
7702; 0410; 2077 /132: Z
1410; 1010; 1014 /133: [
4020; 1004; 0201 /134: \
1404; 0404; 0414 /135: ]
3452; 1010; 1010 /136: ^
0010; 2077; 2010 /137: _

/ END OF PATTERN WORDS



	PAUSE		/FOR IOPACK TO BE ASSEMBLED

7610; 1010; 1010 /124: T
4141; 4141; 4136 /125: U
4141; 4142; 2410 /126: V
4141; 4155; 6341 /127: W
4122; 1414; 2241 /130: X
4122; 1410; 2040 /131: Y
7702; 0410; 2077 /132: Z
1410; 1010; 1014 /133: [
4020; 1004; 0201 /134: \
1404; 0404; 0414 /135: ]
3452; 101