/  FYLHLP - PS/8 UTILITY (DMK)
/0

/  FILE UTILITY PROGRAM FOR PS/8
/  INCLUDES ABILITY TO EXAMINE DIRECTORY
/  AND BLOCKS ON ANY FILE STRUCTURED DEVICE


ZZZ=0
XR17=17
USR=200
CDP=20
TEMP=21
IOROUT=23
DCB=7760
OPT0=7642
OPT1=7643
OPT2=7644

	FIELD 1
	*2000

	JMS 7700	/GO LOCK USR IN CORE
	 10		/LOCK USR IN CORE
HELP1,	JMS I (USR	/GET CD
	 5
	 0		/NO ASSUMED EXTENSION
	TAD (7616
	DCA CDP		/START OF CD INPUT LIST
	TLS
HELP2,	ISZ CDP
	TAD I CDP
	SZA		/DONE THIS LIST?
	JMP HELP3	/NO
	TAD OPT0	/HI ORDER BIT HAS TERMINATOR
			/INDICATOR (CR OR ALT MODE)
	SMA!CLA		/IS ALT MODE BIT SET?
	JMP HELP1	/NO
	CDF!CIF 0
	JMP 7600	/MONITOR

HELP3,	AND (17
	DCA TEMP	/SAVE DEVICE NUMBER
	TAD TEMP
	TAD (DCB-1	/DEVICE 1 AT 'DCB'
	DCA TEMP1	/POINT TO DCB ENTRY
	JMS CRLF
	TAD ("#
	JMS TYO
	TAD I TEMP1
	SMA!CLA		/FILE-STRUCTURED?
	JMP UNFSER
	TAD (IOHNDL+1	/ALLOW TWO PAGE
	DCA TEMP1	/SAVE HANDLER ADDRESS
	TAD TEMP	/DEVICE NUMBER
	JMS I (USR
	 1		/FETCH HANDLER
TEMP1,	 ZZZ
	HLT		/FATAL ERROR
	TAD TEMP1
	DCA IOROUT	/I/O ROUTINE ENTRY POINT
	ISZ CDP
	TAD I CDP
	SZA!CLA		/START BLOCK 0?
	JMP HELP4	/NO
	TAD OPT1	/YES
	AND (200	/E OPTION SET?
	SZA!CLA
	JMP HELP4	/YES
	TAD OPT2	/NO
	AND (40		/CHECK S OPTION
	SZA!CLA
	JMP FYLLUK	/SET
	JMP HELP2

HELP4,	DCA FOUND
	JMS CRLF
	IAC		/FIRST DIRECTORY BLOCK
HELP6,	DCA INBLK
	CIF 0
	JMS I IOROUT
	 210
	 BUF
INBLK,	 ZZZ
	JMP READER
	TAD INBLK-1
	DCA XR17
	TAD I INBLK-1	/FIRST WORD
	DCA NTRCNT	/IS COUNT OF ENTRIES
	TAD I XR17
	CIA
	DCA BLKNUM	/SECOND IS FIRST BLOCK REFERENCED
	ISZ XR17	/BY SEGMENT
	ISZ XR17
	TAD I XR17	/4TH WORD
	DCA XTRAWD	/IS NUMBER OF EXTRA WORDS
HELP7,	TAD I CDP
	TAD BLKNUM
	SNA!CLA		/LOOKING FOR THIS FILE?
	JMP HELP9	/YES
	TAD I XR17	/NO
	SZA!CLA		/FIRST WORD 0?
	JMP HELP8	/NO
	TAD OPT1	/YES
	AND (200	/E OPTION SET?
	SNA!CLA
	JMP HELP12	/NO
	JMS HDRPNT	/YES
	 0
	TAD I XR17
	DCA TEMP	/SAVE BLOCK COUNT
	STL!RTR		/2000
	AND OPT2	/N OPTION
	SZA!CLA		/SET?
	JMP ELP11A	/YES.  SKIP REST OF PRINTING
	JMS MESAGE	/PRINT <EMPTY>
	 EMTYMS
	JMS CRLF
	JMP HELP11


HELP8,	TAD XTRAWD
	CIA
	TAD (3
	TAD XR17
	DCA XR17	/POINT TO COUNT
	JMP HELP12


/0
/1

	PAGE

HELP9,	JMS HDRPNT	/PRINT HEADER
	 1
	ISZ FOUND	/INDICATE FILE FOUND
	STL RTR
	AND OPT2	/N OPTION
	SNA!CLA		/SET?
	JMP HELP9A	/NO
	TAD XTRAWD	/YES.  SET POINTER TO COUNT
	CIA
	TAD (4
	TAD XR17
	DCA XR17
	TAD I XR17	/GET BLOCK COUNT
	DCA TEMP
	JMP ELP11A	/PRINT MESSAGE

HELP9A,	TAD I XR17
	JMS TWDPNT	/FIRST TWO CHARS
	 " 
	TAD I XR17	/NEXT TWO
	JMS TWDPNT
	 " 
	TAD I XR17	/TWO MORE
	JMS TWDPNT
CSPACE,	 " 
	TAD I XR17
	SZA		/IS THERE AN EXTENSION?
	JMP .+4
	JMS OCTPNT	/JUST PRINT 0'S
	JMS CRLF
	JMP .+3
	JMS TWDPNT
CDOT,	 ".
	TAD XTRAWD
	SNA		/ANY EXTRA WORDS?
	JMP HELP11	/NO
	CIA
	TAD (5260	/YES.
	DCA XTRAMS	/SET UP MESSAGE
	TAD XTRAWD
	CMA
	SZA!CLA		/MORE THAN 1?
	TAD (23-40	/S - (SPACE)
	TAD (0440	/D(SPACE)
	DCA XTRAMS+6
	JMS MESAGE
	 XTRAMS
	JMS CRLF
	TAD I XR17
	DCA TEMP	/DATE
	TAD TEMP
	JMS OCTPNT	/PRINT OCTAL
	TAD ("*
	JMS TYO
	JMS TYO
	TAD TEMP
	SNA
	JMP HELP10
	CLL RTL
	RTL
	RAL
	AND (17
	JMS DECPNT
	TAD ("/
	JMS TYO
	TAD TEMP
	RTR
	RAR
	AND (37
	JMS DECPNT
	TAD ("/
	JMS TYO
	TAD TEMP
	AND (7
	TAD (106	/70 (DEC)
	JMS DECPNT
HELP10,	TAD XTRAWD
	DCA TEMP	/SET COUNTER
ELP10A,	JMS CRLF
	ISZ TEMP
	JMP .+4
	TAD I XR17
	DCA TEMP	/BLOCK COUNT
	JMP HELP11
	TAD I XR17
	JMS OCTPNT
	TAD ("*
	JMS TYO
	JMP ELP10A

/1
/2

	PAGE

HELP11, TAD TEMP	/BLOCK COUNT
	JMS OCTPNT
	JMS TYO
	JMS TYO
	JMS MESAGE
	 FLLNM1		/FILE LENGTH
	TAD TEMP
	CIA
	JMS DECPNT	/NUMBER OF BLOCKS
	JMS MESAGE
	 FLLNM2
	JMS CRLF
	JMS CRLF
ELP11A, JMS MESAGE
	 STBLMS		/START BLOCK
	TAD BLKNUM
	CIA
	JMS OCTPNS
	JMS CRLF
	JMS CRLF
	TAD TEMP
	SKP
HELP12, TAD I XR17
	TAD BLKNUM
	DCA BLKNUM	/UPDATE BLOCK NUMBER
	TAD FOUND
	SNA!CLA		/FIND FILE YET?
	JMP HELP14	/NO
	TAD OPT1
	AND (200
	SZA!CLA		/E OPTION SET?
	JMP HELP14
HELP13, TAD OPT2	/NO.
	AND (40		/S OPTION SET?
	SNA!CLA
	JMP HELP2	/NO
	TAD I CDP	/YES
	JMP FYLLUK	/CARRY START BLOCK TO FYLLUK

HELP14, ISZ NTRCNT
	JMP HELP7	/MORE ENTRIES
	TAD BUF+2	/LINK TO NEXT SEGMENT
	SNA		/IS THERE ONE?
	JMP HELP13	/NO.  CONTINUE
	JMP HELP6	/YES.  GET IT

EMTYMS, TEXT '0000  <EMPTY>'
XTRAMS, TEXT '*# EXTRA WORDS*'
FLLNM1, TEXT 'FILE LENGTH = '
FLLNM2, TEXT ' BLOCKS'
STBLMS, TEXT 'FIRST DATA BLOCK = '
HDRMS,	TEXT 'DIRECTORY ENTRY AT '

FOUND, 0
NTRCNT, 0
XTRAWD, 0
BLKNUM, 0


TYO,	.-.
	SNA
	TAD (240
	TSF
	JMP .-1
	TLS
	CLA
	JMP I TYO

CRLF,	.-.
	TAD (215
	JMS TYO
	TAD (212
	JMS TYO
	JMP I CRLF

/2
/3

	PAGE

OCTPNT, .-.		/PRINT OCTAL WITH LEADING 0'S
	JMS OCTPS1
	TAD OCTPNT
	DCA OCTPNS
	ISZ OCTPC1
	JMP OCTPN1

OCTPNS, .-.		/SUPPRESS LEADING 0'S
	JMS OCTPS1
	JMS OCTPS2
	ISZ OCTPC1
	SZA
	SKP
	JMP .-4
	JMS OCTPS3
OCTPN1, JMS OCTPS2
	JMP .-2

OCTPT1, 0
OCTPC1, 0

OCTPS1, .-.
	CLL!RAL
	DCA OCTPT1
	TAD (-4
	DCA OCTPC1
	JMP I OCTPS1

OCTPS2, .-.
	TAD OCTPT1
	RAL
	RTL
	DCA OCTPT1
	TAD OCTPT1
	AND (7
	JMP I OCTPS2

OCTPS3, .-.
	TAD CZERO
	JMS TYO
	TAD OCTPC1
	SNA!CLA
	JMP I OCTPNS
	ISZ OCTPC1
CZERO,	 "0
	JMP I OCTPS3

HDRPNT, .-.		/PRINT HEADER FOR ENTRY
	JMS MESAGE
	 HDRMS
	TAD INBLK
	JMS OCTPNS
	TAD (".
	JMS TYO
	TAD I HDRPNT
	ISZ HDRPNT
	TAD XR17
	TAD (-BUF
	JMS OCTPNS	/PRINT WORD IN BLOCK
	JMS CRLF
	JMS CRLF
	JMP I HDRPNT

TWDPNT, .-.
	DCA TWDPT1
	TAD TWDPT1
	JMS OCTPNT
	TAD TWDPT1
	SZA!CLA		/0?
	JMP .+3
	ISZ TWDPNT	/DON'T PRINT SPACES
	JMP TWDP1
	JMS TYO
	TAD I TWDPNT	/GET SPECIAL SEPARATOR
	ISZ TWDPNT
	JMS TYO
	JMS MESAGE
	 TWDPT1
TWDP1,	JMS CRLF
	JMP I TWDPNT

TWDPT1, 0;0		/SECOND 0 IS NECESSARY

MESAGE, .-.
	CLA
	TAD I MESAGE
	ISZ MESAGE
	DCA MESP
MESA1,	TAD I MESP
	CLL!RTR
	RTR
	RTR
	JMS MESAS1
	TAD I MESP
	JMS MESAS1
	ISZ MESP
	JMP MESA1

MESAS1, .-.
	AND (77
	SNA
	JMP I MESAGE
	TAD (240
	AND (77
	TAD (240
	JMS TYO
	JMP I MESAS1

MESP, 0

/3
/4

	PAGE

/  BEGINNING OF FYLLUK PORTION OF PROGRAM

OPNPTR=22

FYLLUK, DCA CURBLK
	DCA CURADR
	CMA
	DCA MASK
	TAD (">
	JMS TYO
	CMA CLL RAL	/-2.  BECOMES -1 BELOW.  WILL CAUSE
			/NO READ TO OCCUR ON IMMEDIATED ^C, ^P, ^R
FYLL1,	IAC
	DCA FORCE	/FORCE READ
	STL RAR
	DCA WRTLOK	/PREVENT WRITING CORE BUFFER AREA ON READ
FYLL2,	JMS CRLF
FYLL3,	DCA OPEN
FYLL4,	DCA TYPED
	DCA DOTOUT
	DCA EXPBLK
FYLL5,	DCA EXPR
FYLL6,	TAD CURBLK	/DISPLAY CURRENT BLOCK IN AC
	CLL
	KSF
	JMP .-1
	KRB
	DCA CHAR
	TAD (CHRLST-2
	DCA XR17
FYLL7,	ISZ XR17
	TAD I XR17
	SNA		/END OF LIST?
	JMP FYLL8
	TAD CHAR	/NO.
	SZA!CLA		/MATCH CHAR?
	JMP FYLL7	/NO
	TAD I XR17
	DCA TEMP
	JMP I TEMP	/DISPATCH

FYLL8,	TAD EXPR
	CLL!RAL
	CLL!RAL
	CLL!RAL
	DCA EXPR
	TAD CHAR
	TAD (-"7
	SMA!SZA		/LE 7?
	JMP ERROR1	/NO
	TAD (7
	SPA		/GE 0?
	JMP ERROR1	/NO
	TAD EXPR	/YES.  ADD IN
	DCA EXPR
	JMS ECHO
	JMP FYLL6


FETCH,	.-.		/FETCH WORD BY CURBLK.CURADR
	TAD FORCE
	SZA!CLA		/FORCE NEW READ?
	JMP FETCH1	/YES
	TAD CURBLK
	CIA
	TAD REDBLK
	SNA!CLA		/CURBLK=REDBLK?
	JMP FETCH3	/YES.
FETCH1, TAD WRTLOK	/NO.  WRITE, THEN READ
	SPA!CLA		/WRITE LOCK SET?
	JMP FETCH2	/YES.  DON'T WRITE
	TAD CHANGE
	SNA!CLA		/ANY WORDS CHANGE?
	JMP FETCH2	/NO.  DON'T WRITE
	TAD REDBLK
	DCA WRTBLK
	CIF 0
	JMS I IOROUT
	 4210		/WRITE 2 PAGES, FIELD 1
	 BUF
WRTBLK,	 ZZZ
	JMP WRTERR	/ERROR
FETCH2,	DCA WRTLOK	/CLEAR WRITE LOCK
	TAD CURBLK
	DCA REDBLK
	CIF 0
	JMS I IOROUT	/READ
	 210		/2 PAGES, FIELD 1
	 BUF
REDBLK,  ZZZ
	JMP REDERR
	DCA CHANGE
	DCA FORCE
FETCH3,	TAD REDBLK-1
	TAD CURADR
	DCA OPNPTR	/POINT TO WORD IN BLOCK
	TAD I OPNPTR
	JMP I FETCH

WRTLOK, 0
FORCE, 0
CHANGE, 0

REDERR, JMS MESAGE
	 ERR1
	TAD REDBLK
	JMS OCTPNS
	JMP FYLL1

WRTERR, JMS MESAGE
	 ERR2
	TAD WRTBLK
	JMS OCTPNS
	JMP FYLL2	/DON'T MESS WITH FETCH INDICATORS


EXPR, 0
EXPBLK, 0
CHAR, 0

/4
/5

	PAGE

INM,	TAD DOTOUT
	SZA!CLA
	JMP ERROR1	/YES
	TAD OPEN
	SNA!CLA		/LOCATION OPEN?
	JMP INM1	/NO
	TAD TYPED	/YES
	SZA!CLA
	JMP ERROR1	/SOMETHING TYPED
	TAD I OPNPTR	/NOTHING TYPED
	DCA MASK	/USE CURRENT LOCATION AS MASK
	JMP INM2

INM1,	TAD TYPED
	SNA!CLA		/ANYTHING TYPED?
	JMP INM3	/NO
	TAD EXPR	/YES
	DCA MASK	/STORE NEW MASK
INM2,	JMS ECHO
	JMP FYLL2

INM3,	JMS ECHO	/ECHO
	JMS TYO		/SPACE
	TAD MASK
	JMS OCTPNT
	JMP FYLL2

INDOT,	TAD OPEN
	SZA!CLA		/LOCATION OPEN?
	JMP ERROR1	/YES
	TAD DOTOUT
	SZA!CLA		/DOT ALREADY TYPED?
	JMP ERROR1	/YES
	TAD EXPR
	DCA EXPBLK
	ISZ DOTOUT
	JMS ECHO
	JMP FYLL5

INSLSH,	JMS MOVEXP
	JMP ERROR1	/IF NOTHING OPEN OR TYPED
	 CURBLK
	JMS TYO		/SPACE
INSL1,	JMS FETCH
	JMS OCTPNT
	JMS TYO
	IAC
	JMP FYLL3	/SET OPEN

INSTAR,	TAD OPEN
	TAD TYPED
	SZA!CLA		/ANYTHING OPEN OR TYPED?
	JMP ERROR1
	JMS ECHO	/NO
INST1,	JMS ADRPNT	/PRINT CURRENT ADDRESS
	JMP INSL1

INLF,
INCR,	TAD OPEN
	SNA!CLA		/ANYTHING OPEN?
	JMP INLF1	/NO
	TAD TYPED
	SNA CLA		/ANYTHING TYPED?
	JMP INLF1	/NO
	TAD EXPR
	CIA
	TAD I OPNPTR
	SZA!CLA		/VALUE CHANGE?
	ISZ CHANGE	/YES
	TAD EXPR
	DCA I OPNPTR	/STORE CURRENT EXPRESSION
INLF1,	IAC
	AND CHAR
	SZA!CLA		/CHAR EVEN? (LF)
	JMP FYLL2	/NO.  CR
	JMS NXTADR	/YES
	JMP INST1

INL,	TAD (LLBLK-ULBLK
INU,	TAD (ULBLK
	DCA INLIM1
	JMS MOVEXP
	JMP INLIM2	/NOTHING OPEN OR TYPED
INLIM1,  ZZZ
	JMP FYLL2

INLIM2,	JMS ECHO
	JMS TYO		/SPACE
	TAD I INLIM1	/GET BLOCK
	JMS OCTPNS
	TAD (".
	JMS TYO
	ISZ INLIM1
	TAD I INLIM1	/ADDRESS
	JMS OCTPNS
	JMP FYLL2

ECHO,	.-.
	TAD CHAR
	TAD (-240
	SMA!CLA
	JMP .+4
	TAD ("^
	JMS TYO
	TAD (100
	TAD CHAR
	JMS TYO
	ISZ TYPED
	JMP I ECHO

TYPED, 0
OPEN, 0
DOTOUT, 0

/5
/6

	PAGE

INEQ,	TAD (SZA-SNA	/SET UP SKIP
INLT,	TAD (SNA!CLA	/FOR SEARCH
	DCA SRHSKP
	JMS ECHO
	TAD CURBLK
	DCA HLDBLK	/KEEP CURRENT BLOCK
	TAD CURADR
	DCA HLDADR	/AND ADDRESS
	TAD LLBLK
	DCA CURBLK
	TAD LLADR
	DCA CURADR
	JMS SRHTST
	SKP		/NOT AT END
	JMP SRCH3
SRCH1,	JMS FETCH	/GET WORD
	AND MASK
	CIA
	TAD EXPR
SRHSKP,  ZZZ		/SKIP GOES HERE
	JMP SRCH2	/TEST FAILED
	JMS ADRPNT
	TAD I OPNPTR
	JMS OCTPNT
	TAD CURBLK
	DCA HLDBLK
	TAD CURADR
	DCA HLDADR	/KEEP LAST LOCATION OPEN
SRCH2,	KSF		/CHARACTER TYPED?
	JMP .+3		/NO
	KCC		/CLEAR FLAG
	JMP SRCH3	/THEN END SEARCH
	JMS NXTADR
	JMS SRHTST	/FINISH?
	JMP SRCH1	/NO
SRCH3,	TAD HLDBLK	/YES
	DCA CURBLK
	TAD HLDADR
	DCA CURADR	/RESTORE ADR OF LAST LOC OPEN
	JMP FYLL2

SRHTST, .-.
	TAD ULBLK
	CIA
	TAD CURBLK
	SZA		/BLOCKS EQUAL?
	JMP .+4		/NO
	TAD ULADR
	CIA
	TAD CURADR
	SMA!SZA!CLA	/CURADR>ULADR?
	ISZ SRHTST	/YES.  DONE
	JMP I SRHTST

HLDBLK, 0
HLDADR, 0
LLBLK, 0
LLADR, 0
ULBLK, 0
ULADR, 0
MASK, 0


INC,	TAD OPEN
	TAD TYPED
	SZA!CLA		/ANYTHING OPEN OR TYPED?
	JMP ERROR1	/YES
	JMS ECHO	/NO
	JMP FYLL1	/SET WRITE LOCK AND FORCE

MOVEXP, .-.		/MOVE ADDRESS EXPRESSION
	TAD OPEN
	SZA!CLA		/LOCATION OPEN?
	JMP ERROR1	/YES
	TAD TYPED
	SNA!CLA		/SOMETHING TYPED?
	JMP I MOVEXP	/NO
	JMS ECHO
	ISZ MOVEXP	/YES
	TAD I MOVEXP	/ADDRESS TO MOVE TO
	ISZ MOVEXP
	DCA MOVEP1
	TAD EXPR
	AND (7400	/CHECK UPPER LIMIT (377)
	SZA!CLA		/<=377?
	JMP ERROR2
	TAD DOTOUT
	SNA!CLA
	JMP .+3		/DOT NOT TYPED
	TAD EXPBLK
	SKP
	TAD CURBLK	/USE CURBLK
	DCA I MOVEP1
	ISZ MOVEP1
	TAD EXPR
	DCA I MOVEP1
	JMP I MOVEXP

MOVEP1, 0

/6
/7

	PAGE

NXTADR, .-.
	ISZ CURADR
	TAD CURADR
	TAD (-377
	SPA SNA CLA	/ADR>377?
	JMP I NXTADR	/NO
	DCA CURADR	/YES.  ADR=0
	ISZ CURBLK
	NOP
	JMP I NXTADR	/BLK HAS NO UPPER BOUND

ADRPNT, .-.		/PRINT ADDRESS
	JMS CRLF
	TAD CURBLK
	JMS OCTPNS
	TAD (".
	JMS TYO
	TAD CURADR
	JMS OCTPNS
	TAD ("/
	JMS TYO
	JMS TYO
	JMP I ADRPNT

CURBLK, 0
CURADR, 0

ERROR1, CLA
	JMS ECHO
INRO,
ERROR2, TAD ("?
	JMS TYO
	JMS TYO
	JMP FYLL4

ERR1,	TEXT 'READ ERROR, BLOCK '
ERR2,	TEXT 'WRITE ERROR, BLOCK '

READER, JMS MESAGE
	 ERR1
	TAD INBLK
	JMS OCTPNS
	JMP HELP2

UNFSER, JMS MESAGE
	 ERR3A
	TAD CDP
	TAD (-7617+2
	CLL!RAR		/GIVES REQUEST NUMBER
	TAD ("0
	JMS TYO
	JMS MESAGE
	 ERR3B
	ISZ CDP
	JMS CRLF
	JMP HELP2

ERR3A,	TEXT 'DEVICE IN REQUEST #'
ERR3B,	TEXT ' IS NOT FILE-STRUCTURED'


/7
/8

	PAGE

CHRLST, -215;INCR
	-257;INSLSH
	-212;INLF
	-256;INDOT
	-377;INRO
	-314;INL
	-325;INU
	-315;INM
	-303;INC
	-274;INLT
	-275;INEQ
	-252;INSTAR
	-220;INCTLP
	-222;INCTLR
	-203;INCTLC;0


INCTLP, IAC
INCTLR, IAC
INCTLC, DCA TEMP
	TAD OPEN
	TAD TYPED	/ANYTHING OPEN OR TYPED?
	SZA!CLA
	JMP ERROR1
	JMS ECHO
	JMS CRLF
	ISZ FORCE	/FORCED READ WILL FORCE WRITE
			/IF NECESSARY.  SKIPS IF NO READ DONE
			/YET.
	JMS FETCH	/TO DO WRITE
	CLA		/IGNORE AC
	TAD TEMP
	SNA
	CDF CIF 0	/^C RETURNS TO MONITOR
	TAD .+3
	DCA .+1
	ZZZ
	JMP I .+1
	 7600;HELP1;HELP2


DECPNT, .-.		/PRINT DECIMAL, SUPPRESS 0'S
	DCA DECPT1
	CLA!CMA!CLL!RTL
	DCA DECPC1	/-3
	TAD DECPI1
	DCA DECP3
	DCA DECPT2	/CHAR. OUT INDICATOR
DECP1,	DCA DECPT3	/0 TO DIGIT COUNT
DECP2,	TAD DECPT1
	CLL		/FOR TEST
DECP3,	TAD DECPL1	/GETS INCREMENTED
	SNL		/OVERFLOW?
	JMP DECP4	/YES
	DCA DECPT1	/NO
	ISZ DECPT3	/INC. DIGIT COUNT
	JMP DECP2

DECP4,	CLA
	TAD DECPT3	/DIGIT COUNT
	TAD DECPT2	/CHAR OUT IND.
	SNA
	JMP DECP5	/IGNORE LEADING ZERO
	TAD ("0
	JMS TYO
	STL!RAR
	DCA DECPT2	/SET CHAR OUT IND.
DECP5,	ISZ DECP3	/POWER OF TEN POINTER
	ISZ DECPC1
	JMP DECP1
	TAD DECPT1
	TAD ("0		/ALWAYS PRINT LAST DIGIT
	JMS TYO
	JMP I DECPNT

DECPT1, 0
DECPT2, 0
DECPT3, 0
DECPC1, 0
DECPI1, TAD .+1
DECPL1, -1750;-144;-12

	PAGE

BUF=.
IOHNDL=.+400	/ALLOW 400 FOR 'BUF', ALLOW 2 PAGE
		/HANDLER

$
/8