Google
 

Trailing-Edge - PDP-10 Archives - CFS_TSU04_19910205_1of1 - update/srtsrc/srtcer.mac
There are 10 other files named srtcer.mac in the archive. Click here to see a list.
; UPD ID= 83 on 10/25/83 at 3:04 PM by FONG                             
TITLE	SRTCER	- COBOL SORT ERROR ROUTINES
SUBTTL	STOLEN FROM SCAN - D.M.NIXON/DZN	15-Oct-82

	SEARCH COPYRT
	SALL

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.

COPYRIGHT (C) 1975, 1983 ,1984 BY DIGITAL EQUIPMENT CORPORATION


	SEARCH	SRTPRM
	XSEARCH			;SEARCH OTHER UNIVERSALS
IFN FTPRINT,<PRINTX [Entering SRTCER.MAC]>

	.COPYRIGHT		;Put standard copyright statement in REL file
	SEGMENT	HPURE
SUBTTL	TABLE OF CONTENTS FOR SRTCER


;                    Table of Contents for SRTCER
;
;
;                             Section                             Page
;
;   1  SRTCER  - COBOL SORT ERROR ROUTINES ......................   1
;   2  TABLE OF CONTENTS FOR SRTCER .............................   2
;   3  DEFINITIONS
;        3.1  Impure Data .......................................   3
;        3.2  Parameters From SCNMAC, etc. ......................   4
;   4  TYPE-OUT ROUTINES
;        4.1  Issue Standard Error Message Prefixes .............   5
;        4.2  Return /MESSAGE: Setting ..........................   6
;        4.3  Type OPEN and LOOKUP/RENAME/ENTER Blocks ..........   7
;        4.4  Directory Block ...................................   8
;        4.5  Masked (Wild) Octal Word in XWD Format ............   9
;        4.6  Disk Blocks, Memory Size ..........................  10
;        4.7  Time of Day in HH:MM:SS Format ....................  11
;        4.8  CRLF, PPN, ']', SIXBIT ............................  12
;        4.9  Octal XWD Format and Signed Octal, Decimal, Radix .  13
;        4.10  ASCIZ String, Character, ' '  ','  ':'  '*' ......  14
;   5  SAVE AND RESTORE ROUTINES
;        5.1  .SAVE4, save P1-P4 ................................  16
;        5.2  .PSH4T, save T1-T4 ................................  16
;        5.3  .POP4T, restore T1-T4 .............................  16
SUBTTL	DEFINITIONS -- Impure Data

	SEGMENT	IMPURE		;[C20]

	LD	(.FLVRB,1)	;MASK,,SET OF /MESSAGE BITS
	LD	(.FLCBF,1)	;FLAG TO CLEAR TYPEAHEAD
	LD	(TYPOUT,1)	;ADDRESS OF CHARACTER OUTPUT ROUTINE
	LD	(FILSPC,50)	;PLACE TO STORE AN ASCIZ FILESPEC

	SEGMENT	LPURE		;[C20]

.TNEWL==.TCRLF
SUBTTL	DEFINITIONS -- Parameters From SCNMAC, etc.

IFN FTOPS20,<
;DEFINE BITS USED BY VERBOSITY CHECK

JWW.CN==1B9		;/MESSAGE:CONTINUATION
JWW.FL==1B10		;/MESSAGE:FIRST
JWW.PR==1B11		;/MESSAGE:PREFIX
JW.WMS==JWW.CN+JWW.FL+JWW.PR	;/MESSAGE LEVEL
>
IFE FTOPS20,<
FT$SFD==-1			;SFDS FOR SCAN
>
VRBADX==10			;/MESSAGE:ADDRESS

;GLOBAL ROUTINES
INTERN	.ERMSG,.TCHAR,.TCORW,.TCRLF,.TDECW,.TOCTW,.TRBRK,.TSIXN,.TSTRG,.TTIME,.TYOCH,.TOLEB
INTERN	.POP4T,.PSH4T,.SAVE4
SUBTTL	TYPE-OUT ROUTINES -- Issue Standard Error Message Prefixes

;CALL:	1/ MODULE CODE (0=SYSTEM),,MESSAGE CODE   IN SIXBIT
;	2/ (11) ??? (7) LEAD CHAR,,[ASCIZ TEXT]
;	3/ ???,,ADDRESS OF ERROR IF .ERMSA
;	PUSHJ P,.ERMSG/.ERMSA
;RETURN +1 WITH 1/ LH(ARG 2),,/VERBOS BITS
;USES T2-4

.ERMSG:	MOVEI	T3,0		;CLEAR ADDRESS
.ERMSA:	PUSH	P,T2		;SAVE CONTROL BITS
	PUSH	P,T3		;SAVE ADDRESS
	PUSH	P,T1		;SAVE PREFIXES
	HLRZ	T1,T2		;GET PREFIX CHARACTER
	ANDI	T1,177		;MASK TO JUST LEAD CHARACTER
	SKIPE	TYPOUT		;IS THERE AN ALTERNATE TYPEOUT ROUTINE?
	JRST	ERMSG2		;YES, IT WILL HAVE TO CLEAR ^O ITSELF
	CAIN	T1,"?"		;IF FATAL ERROR,
	SKIPE	.FLCBF		;SEE IF FIRST FATAL ERROR
	JRST	ERMSG2		;NO
	CLEARO			;YES--CLEAR ^O
	HLRZ	T1,-2(P)	;[137] CLEARO MAY DESTROY T1, T2
	ANDI	T1,177		;[137]   SO BE SAFE
	SETOM	.FLCBF		; INDICATE TO CLEAR TYPE-AHEAD
ERMSG2:	PUSHJ	P,.TNEWL	;GO TO START OF LINE
	PUSHJ	P,.TCHAR	;ISSUE LEAD CHARACTER
	PUSHJ	P,.VERBO	;GET /MESSAGE
	MOVE	T4,T1		;COPY TO SAFER PLACE
	POP	P,T1		;GET PREFIX
	TLNN	T1,-1		;SEE IF SYSTEM CODE
	HRLZS	T1		;YES--REMOVE SPACES
	TXNE	T4,JWW.PR	;SEE IF /VERBOS:PREFIX
	PUSHJ	P,.TSIXN	;YES--ISSUE PREFIX
	POP	P,T3		;GET ADDRESS OF CALL
	TRNE	T3,-1		;SEE IF CALL ADDRESS SET
	TXNN	T4,1_<VRBADX-1>	; AND IF USER ASKED FOR IT
	JRST	ERMSG1		;NO--PROCEED BELOW
	MOVEI	T1,"("		;YES--INDICATE
	PUSHJ	P,.TCHAR	; ADDRESS
	HRRZ	T1,T3		;GET ADDRESS
	PUSHJ	P,.TOCTW	; TYPE IN OCTAL
	MOVEI	T1,")"		;GET END
	PUSHJ	P,.TCHAR	; AND INDICATE
ERMSG1:	PUSHJ	P,.TSPAC	;SPACE OVER TO TEXT AREA
	HRRZ	T1,(P)		;GET TEXT ADDRESS
	TXNE	T4,JWW.FL	;SEE IF /MESSAGE:FIRST
	PUSHJ	P,.TSTRG	;YES--ISSUE TEXT
	POP	P,T1		;RESTORE FLAGS (???)
	ANDX	T4,JWW.CN!JWW.FL ;REMOVE JUNK BITS
	HRR	T1,T4		;MOVE TO ANSWER
	POPJ	P,		;RETURN
SUBTTL	TYPE-OUT ROUTINES -- Return /MESSAGE: Setting

;CALL:	PUSHJ	P,.VERBO
;RETURNS T1/BITS IN JWW.?? FORMAT

.VERBO:	
IFE FTOPS20,<
	HRROI	T1,.GTWCH	;GET FROM MONITOR
	GETTAB	T1,		;THE USER'S DEFAULT
	  MOVEI	T1,0		;(DEFAULT TO 0)
	TXNN	T1,JW.WMS	;SEE IF SET
	TXO	T1,.JWWPO_<ALIGN. (JW.WMS)>  ;NO--DEFAULT TO PREFIX,FIRST
	ANDX	T1,JW.WMS	;REMOVE JUNK
	LSH	T1,^D18-<ALIGN.(JW.WMS)> ;ALIGN IN LEFT HALF
	ANDCM	T1,.FLVRB	;CLEAR ANY SET IN SWITCH
	HLRZS	T1		;POSITION TO RIGHT
	IOR	T1,.FLVRB	;INCLUDE ANY SET IN SWITCH
	TLZ	T1,-1		;CLEAR JUNK
	TRNE	T1,JWW.CN	;SEE IF CONTINUATION
	TRO	T1,JWW.FL	;YES--SET FIRST
	SKIPN	T1		;SEE IF ANYTHING LEFT
	TRO	T1,.JWWPO	;NO--SET FIRST,PREFIX
>
IFN FTOPS20,<
	MOVX	T1,JW.WMS	;FORCE FULL MESSAGE OUT
>
	POPJ	P,		;RETURN
SUBTTL	TYPE-OUT ROUTINES -- Type OPEN and LOOKUP/RENAME/ENTER Blocks

;CALL:	1/ ADDRESS OF OPEN BLOCK
;	2/ ADDRESS OF EXTENDED LOOKUP/ENTER BLOCK
;	PUSHJ	P,.TOLEB
;USES T1-4

IFN FTOPS20,<
.TOLEB:	HRROI T1,FILSPC		;TYPE INTO FILE SPEC BUFFER
	SKIPN TYPOUT		;IS THERE AN ALTERNATE TYPEOUT ROUTINE?
	MOVX T1,.PRIOU		;NO-TYPE ON PRIMARY OUTPUT JFN
				;JFN IN T2 (USED BY $MORE MACRO)
	MOVX T3,<1B2+1B5+1B8+1B11+1B14+1B21>!JS%PAF ;TYPE ALL FIELDS
	JFNS%			;[335]   TYPE IT
	SKIPN	TYPOUT		;ALTERNATE ROUTINE?
	POPJ	P,		;NO, WE ARE DONE
	MOVEI	T1,FILSPC	;GET ADDRESS OF FILE SPEC BUFFER
	PJRST	.TSTRG		;GO TYPE THE STRING
>

IFE FTOPS20,<
.TOLEB:	MOVE	T4,T2		;MAKE SAFE COPY
	MOVE	T1,.OPDEV(T1)	;[OK] GET DEVICE
	PUSHJ	P,.TSIXN	;ISSUE IT
	PUSHJ	P,.TCOLN	;ISSUE SEPARATOR
	MOVE	T1,.RBNAM(T4)	;[OK] GET FILE NAME
	HLRZ	T2,.RBEXT(T4)	;[OK] GET EXTENSION
	CAIN	T2,'UFD'	;SEE IF UFD
	JUMPG	T1,[PUSHJ P,.TPPNW	;YES--TYPE AS P,PN
		    JRST  .+2]		;PROCEED
	PUSHJ	P,.TSIXN	;ELSE ISSUE IN SIXBIT
	MOVEI	T1,"."		;INDICATE EXTENSION
	PUSHJ	P,.TCHAR	;ISSUE IT
	HLLZ	T1,.RBEXT(T4)	;[OK] GET EXTENSION
	PUSHJ	P,.TSIXN	;ISSUE THAT
	MOVEI	T1,.RBPPN(T4)	;[OK] POINT TO DIRECTORY
	PJRST	.TDIRB		;GO TYPE THAT AND RETURN
SUBTTL	TYPE-OUT ROUTINES -- Directory Block

;STILL IN IFE FTOPS20
;CALL:	MOVEI	T1,ADDRESS OF DIRECTORY WORD OR PATH OR BIWORDS
;	TLO	T1,0 FOR WORD, 1 FOR PATH, 2 FOR BIWORDS
;	PUSHJ	P,.TDIRB
;USES T1-4

.TDIRB:	
  IFE FT$SFD,<
	SKIPE	T1,(T1)		;[OK] SEE IF SOMETHING
	PJRST	.TPPNW		;YES--PRINT IT
	POPJ	P,
  >
  IFN FT$SFD,<
	MOVE	T4,T1		;SAVE POINTER
	SKIPN	T1,(T4)		;[OK] SEE IF SOMETHING THERE
	JRST	[HLRZ T2,T4	;NO--SEE IF BIWORDS
		 CAIN T2,2	; ..
		 SKIPN 2(T4)	;[OK] YES--SEE IF SOMETHING LATER ON
		 POPJ	P,	;NO--RETURN
		 JRST TDIRB1]	;PROCEED WITH OUTPUT
	TLNE	T4,-1		;SEE IF STRAIGHT
	JRST	TDIRB1		;NOPE--DO IT THE HARD WAY
	TLNE	T1,-1		;YES--SEE IF SFD
	PJRST	.TPPNW		;NO--JUST UFD
	MOVEI	T4,2(T1)	;[OK] YES--CHANGE POINTER

TDIRB1:	HLRZ	T1,T4		;GET LENGTH
	SUBI	T1,2		;SET FLAG -1 FOR SINGLE, 0 FOR BIWORDS
	PUSH	P,T1		;SAVE FOR LATER TESTING
	HRLI	T4,-.FXLND	;SET LENGTH
	MOVEI	T1,"["		;OUTPUT BREAK
	PUSHJ	P,.TCHAR	; ..
	HRRZ	T1,T4		;[C20] GET UFD
	MOVE	T1,(T1)		;[C20]   ..
	JUMPL	T1,[PUSHJ P,.TSIXN
		    JRST  TDIRB2]
	SKIPL	(P)		;SEE IF DOUBLE
	JRST	[HRRZ  T2,T4	;[C20] YES--GET MASK
		 MOVE  T2,1(T2)	;[C20]   ..
		 PUSHJ P,.TXWWW	;OUTPUT MASKED OCTAL XWD
		 JRST  TDIRB2]	;AND PROCEED
	PUSHJ	P,.TXWDW	;TYPE IT
TDIRB2:	AOBJP	T4,TDIRB3	;LOOP UNTIL DONE
	SKIPL	(P)		;IF BIWORDS,
	AOS	T4		;  MOVE UP ONE EXTRA
	HRRZ	T1,T4		;[C20]  ..
	SKIPN	(T1)		;[C20]  ..
	JRST	TDIRB3		;YES--RETURN TYPING LAST BREAK
	PUSHJ	P,.TCOMA	;TYPE A COMMA
	HRRZ	T1,T4		;[C20] GET SFD NAME
	MOVE	T1,(T1)		;[C20]   ..
	PUSHJ	P,.TSIXN	;TYPE IT
	JRST	TDIRB2		; AND LOOP UNTIL DONE
TDIRB3:	POP	P,(P)		;THROW AWAY FLAG
	JRST	.TRBRK		;AND FINISH UP
  >
SUBTTL	TYPE-OUT ROUTINES -- Masked (Wild) Octal Word in XWD Format

;STILL IN IFE FTOPS20
;CALL:	MOVE	T1,WORD
;	MOVE	T2,MASK
;	PUSHJ	P,.TXWWW
;USES T1-3

.TXWWW:	MOVSS	T2		;T1,T2=LH(V),RH(V),RH(M),LH(M)
	ROTC	T1,-^D18	;T1,T2=LH(M),LH(V),RH(V),RH(M)
	PUSH	P,T2		;SAVE SECOND HALF (V,,M)
	MOVSS	T1		;T1=LH  V,,M
	PUSHJ	P,.TMOHW	;TYPE MASKED OCTAL HALF-WORD
	PUSHJ	P,.TCOMA	;TYPE COMMA
	POP	P,T1		;RESTORE RH  V,,M
				;FALL INTO .TMOHW

;.TMOHW -- TYPE MASKED OCTAL HALF-WORD
;CALL:	MOVE	T1,[VALUE,,MASK]
;	PUSHJ	P,.TMOHW
;USES T1-3

.TMOHW:	TRCN	T1,-1		;MAKE MASK BIT 0 IF NOT WILD
	PJRST	.TASTR		;TYPE * IF ALL WILD
	MOVE	T2,T1		;MOVE TO CONVENIENT PLACE
	MOVEI	T3,6		;SET LOOP COUNT
TMOHW1:	MOVEI	T1,0		;CLEAR ACCUMULATOR
	LSHC	T1,3		;POSITION FIRST DIGIT
	JUMPN	T1,TMOHW3	;GO IF NON-ZERO
	SOJG	T3,TMOHW1	;LOOP UNTIL ALL DONE
TMOHW2:	MOVEI	T1,0		;CLEAR ACCUMULATOR
	LSHC	T1,3		;GET NEXT DIGIT
TMOHW3:	ADDI	T1,"0"		;CONVERT TO ASCII
	TLNE	T2,7		;CHECK MASK
	MOVEI	T1,"?"		;CHANGE TO ? IF WILD
	PUSHJ	P,.TCHAR	;TYPE CHARACTER
	SOJG	T3,TMOHW2	;LOOP UNTIL DONE
	POPJ	P,		;RETURN

>;END IFE FTOPS20
SUBTTL	TYPE-OUT ROUTINES -- Disk Blocks, Memory Size

;.TCORW -- TYPE NUMBER IN CORE SIZE
;CALL:	1/ SIZE TO TYPE
;	PUSHJ	P,.TBLOK/.TCORW
;USES T1-4

REPEAT 0,<
.TBLOK:	TRNE	T1,177		;SEE IF EVEN BLOCKS
	PJRST	TCORWD		;NO--ISSUE IN WORDS
	MOVE	T4,["B",,177]	;ELSE INDICATE BLOCKS
	JRST	TCORTP		;AND GO OUTPUT
>

.TCORW:	JUMPE	T1,TCORWD	;IF NULL, DO IN WORDS
IFE FTOPS20,<
	MOVE	T4,["K",,1777]	;PRESET FOR K
	JUMPPT	(T2,TCORKA,TCORKA)  ;IF PDP-6 OR KA-10, DO IN K
>
	MOVE	T4,["P",,777]	;ELSE, INDICATE PAGES
TCORKA:	TDNE	T1,T4		;SEE IF ROUND UNITS
	JRST	TCORWD		;NO--DO IN WORDS
TCORTP:	HRRZ	T2,T4		;[C20] YES--DIVIDE BY UNITS
	IDIVI	T1,1(T2)	;[C20]   ..
	SKIPA			; AND OUTPUT
TCORWD:	MOVSI	T4,"W"		;INDICATE WORDS
	PUSHJ	P,.TDECW	;ISSUE SIZE
	HLRZ	T1,T4		;GET SIZE UNIT INDICATOR
	PJRST	.TCHAR		;ISSUE THAT AND RETURN
SUBTTL	TYPE-OUT ROUTINES -- Time of Day in HH:MM:SS Format

IFN FTOPS20!FTCOBOL!FTFORTRAN,<
;CALL:	MOVEI	T1,TIME IS MILLISEC SINCE MIDNIGHT
;	PUSHJ	P,.TTIME
;USES T1-4

;WARNING: THIS ROUTINE TRUNCATES THE TIME; IT WILL PRINT 15:59:59.995
;	AS 15:59:59, NOT 16:00:00. THIS IS BECAUSE A ROUND UP COULD
;	CAUSE THE DAY TO INCREMENT, AND THIS ROUTINE DOESN'T KNOW THE
;	DAY (IT HAS PROBABLY ALREADY BEEN PRINTED).  THE CALLER OF THIS
;	ROUTINE MUST MAKE SURE THE TIME HAS ALREADY BEEN ROUNDED TO THE
;	NEAREST SECOND HIMSELF.  SEE THE CODE AT .TDTTM FOR AN EXAMPLE.

.TTIME:	IDIV	T1,[^D3600000]	;[C20] GET HOURS
	MOVE	T4,T2		;SAVE REST
	MOVEI	T2," "		;FILL WITH SPACE
	PUSHJ	P,.TDEC2	;TYPE TWO DIGITS
	PUSHJ	P,.TCOLN	;TYPE COLON
	MOVE	T1,T4		;RESTORE REST
	IDIVI	T1,^D60000	;GET MINS
	MOVE	T4,T2		;SAVE REST
	PUSHJ	P,TDEC2Z	;TYPE TWO DIGITS WITH 0 FILLER
	PUSHJ	P,.TCOLN	;TYPE COLON
	MOVE	T1,T4		;RESTORE THE REST
	IDIVI	T1,^D1000	;GET SECONDS
TDEC2Z:	MOVEI	T2,"0"		;FILL WITH 0
				;FALL INTO .TDEC2

;.TDEC2 -- TYPE DECIMAL AT LEAST TWO DIGITS
;CALL:	SAME AS .TDECW WITH T2=FILLER CHAR (" " OR "0")

.TDEC2:	JUMPL	T1,.TDECW	;JUMP IF NEGATIVE
	CAILE	T1,^D9		;SEE IF ONE DIGIT
	PJRST	.TDECW		;NO--JUST OUTPUT
	EXCH	T1,T2		;GET FILLER
	PUSHJ	P,.TCHAR	;TYPE
	MOVE	T1,T2		;[C20] CONVERT DIGIT
	ADDI	T1,"0"		;[C20]   ..
	PJRST	.TCHAR		;OUTPUT IT AND RETURN
>;END IFN FTOPS20!FTCOBOL!FTFORTRAN
SUBTTL	TYPE-OUT ROUTINES -- CRLF, PPN, ']', SIXBIT

;CALL:	PUSHJ	P,.TCRLF
;PRESERVES ALL ACS

.TCRLF:	PUSH	P,T1		;SAVE CHARACTER
	MOVEI	T1,.CHCRT	;GET CARRIAGE RETURN
	PUSHJ	P,.TCHAR
	MOVEI	T1,.CHLFD	;GET LINE FEED
	PUSHJ	P,.TCHAR	;TYPE IT
TPOPJ:	POP	P,T1		;RESTORE CHARACTER
	POPJ	P,		;RETURN

IFE FTOPS20,<
;.TPPNW -- SUBROUTINE TO TYPE A PPN
;CALL:	MOVE	T1,PPN
;	PUSHJ	P,.TPPNW
;USES	T1, T2, T3

.TPPNW:	PUSH	P,T1		;SAVE ARGUMENT
	MOVEI	T1,"["
	PUSHJ	P,.TCHAR
	POP	P,T1		;RECOVER ARGUMENT
	JUMPL	T1,[PUSHJ P,.TSIXN
		    JRST  .TRBRK]
	PUSHJ	P,.TXWDW	;TYPE XWD
>
.TRBRK:	MOVEI	T1,"]"
	PJRST	.TCHAR

;.TSIXN -- TYPE OUT SIXBIT WORD
;CALL:	MOVE	T1,WORD
;	PUSHJ	P,.TSIXN
;USES T1, T2

.TSIXN:	MOVE	T2,T1		;MOVE ARGUMENT
TSIXN1:	JUMPE	T2,.POPJ	;LOOP UNTIL ONLY BLANKS LEFT
	MOVEI	T1,0		;CLEAR NEXT CHARACTER
	LSHC	T1,6		;GET NEXT CHARACTER
	ADDI	T1," "-' '	;CONVERT TO ASCII
	PUSHJ	P,.TCHAR	;TYPE IT
	JRST	TSIXN1		; ..
SUBTTL	TYPE-OUT ROUTINES -- Octal XWD Format and Signed Octal, Decimal, Radix

;CALL:	MOVE	T1,WORD
;	PUSHJ	P,.TXWDW
;USES T1, T2, T3

.TXWDW:	PUSH	P,T1		;PRESERVE ARGUMENT
	HLRZ	T1,T1
	PUSHJ	P,.TOCTW
	PUSHJ	P,.TCOMA	;ISSUE COMMA
	POP	P,T1		;RESTORE ARGUMENT
	HRRZ	T1,T1
			;FALL INTO .TOCTW


;.TDECW -- TYPE OUT SIGNED DECIMAL NUMBER
;.TOCTW -- TYPE OUT SIGNED OCTAL NUMBER
;.TRDXW -- TYPE OUT SIGNED NUMBER (RADIX IN T3)
;	(IF RADIX .GT. 9, WILL USE ALPHAS AFTER DIGITS)
;CALL:	MOVE	T1,NUMBER
;	PUSHJ	P,.TOCTW/.TDECW/.TRDXW
;USES T1, T2, T3

.TOCTW:	SKIPA	T3,[10]		;INITIALIZE FOR OCTAL RADIX
.TDECW:	MOVEI	T3,^D10		;INITIALIZE FOR DECIMAL RADIX

.TRDXW:	JUMPGE	T1,TRDXW1	;CHECK FOR NEGATIVE
	MOVE	T2,T1		;SAVE AWAY ARGUMENT
	MOVEI	T1,"-"		;YES--GET MINUS
	PUSHJ	P,.TCHAR	;PRINT IT
	MOVE	T1,T2		;RESTORE NUMBER
TRDXW1:	IDIV	T1,T3		;DIVIDE BY RADIX
	MOVMS	T2		;GET MAGNITUDE
	PUSH	P,T2		;[C20] SAVE REMAINDER
	SKIPE	T1		;SEE IF ANYTHING LEFT
	PUSHJ	P,TRDXW1	;YES--LOOP BACK WITH PD LIST
	POP	P,T1		;[C20] GET BACK A DIGIT
	ADDI	T1,"0"		;CONVERT TO ASCII
	CAILE	T1,"9"		;SEE IF OVERFLOW DIGITS
	ADDI	T1,"A"-"9"	;YES--SWITCH TO ALPHABETICS
	PJRST	.TCHAR		;TYPE IT AND RETURN
SUBTTL	TYPE-OUT ROUTINES -- ASCIZ String, Character, ' '  ','  ':'  '*'

;CALL:	MOVEI	T1,LOCTN. OF STRING
;	PUSHJ	P,.TSTRG
;USES T1

.TSTRG:	HRLI	T1,(POINT 7)	;CONVERT ADDRESS TO POINTER
	TRNN	T1,-1		;SEE IF SOMETHING THERE
	POPJ	P,		;NO--RETURN EMPTY HANDED
	PUSH	P,T1		;STORE IN SAFE PLACE
TSTRG1:	ILDB	T1,(P)		;GET NEXT CHARACTER
	JUMPE	T1,TPOPJ	;RETURN WHEN DONE
	PUSHJ	P,.TCHAR	;OUTPUT CHARACTER
	JRST	TSTRG1		;LOOP UNTIL DONE


;.TCHAR -- TYPE ASCII CHARACTER
;CALL:	MOVEI	T1,CHARACTER
;	PUSHJ	P,.TCHAR
;PRESERVES ALL ACS

;.TSPAC -- TYPE ASCII SPACE
;.TTABC -- TYPE ASCII TAB
;.TCOMA -- TYPE ASCII COMMA
;.TCOLN -- TYPE ASCII COLON
;.TASTR -- TYPE ASCII ASTERISK
;CALL:	PUSHJ	P,.TXXXX
;USES T1

IFE FTOPS20,<
.TASTR:	MOVEI	T1,"*"		;GET ASTERISK
	PJRST	.TCHAR		;ISSUE AND RETURN
>
.TCOLN:	MOVEI	T1,":"		;GET COLON
	PJRST	.TCHAR		;ISSUE AND RETURN
.TCOMA:	MOVEI	T1,","		;GET COMMA
	PJRST	.TCHAR		;ISSUE AND RETURN
REPEAT 0,<
.TTABC:	MOVEI	T1,.CHTAB	;GET TAB
	PJRST	.TCHAR		;ISSUE AND RETURN
>

.TSPAC:	MOVEI	T1," "		;GET SPACE
.TCHAR:	TRNN	T1,177		;SEE IF NULL
	POPJ	P,		;YES--IGNORE
	SKIPE	TYPOUT		;SEE IF ALTERNATE TYPEOUT ROUTINE
	PJRST	@TYPOUT		;YES, CALL IT
	TYPEC	(T1)		;LET MONITOR DO IT
	POPJ	P,		;AND RETURN

.TYOCH:	EXCH	T1,TYPOUT	;SET NEW TYPEOUT ROUTINE
	POPJ	P,		;AND RETURN WITH OLD ROUTINE ADDRESS
SUBTTL	.SAVE4 - SUBROUTINE TO SAVE P1-4 FOR A SUBROUTINE

;CALL:	PUSHJ	P,.SAVE4
;RETURN POPJ OR .POPJ1, RESTORES P1-4 AND SKIPS OR NOT

IFE FTCOBOL,<
.SAVE4:	EXCH	P1,(P)		;SAVE P1, GET CALLER PC
	PUSH	P,P2		;SAVE P2
	PUSH	P,P3		;SAVE P3
	PUSH	P,P4		;SAVE P4
	PUSH	P,		;[C20] MAKE SPACE FOR RETURN PC
	PUSH	P,P1		;[C20] SAVE CALLER PC
	XMOVEI	P1,.SAVX4	;[C20] SAVE RETURN PC
	MOVEM	P1,-1(P)	;[C20]   ..
	MOVE	P1,-5(P)	;[C20] RESTORE P1
	POPJ	P,		;[C20] RETURN TO CALLER
.SAVX4:	  SOS	-4(P)		;NON-SKIP RETURN, COMPENSATE .POPJ1

RET4:	POP	P,P4		;RESTORE P4
RET3:	POP	P,P3		;RESTORE P3
RET2:	POP	P,P2		;RESTORE P2
RET1:	POP	P,P1		;RESTORE P1
>
.POPJ1:	AOS	(P)		;INCREMENT PC
.POPJ:	POPJ	P,		;RETURN


;.PSH4T -- PUSH T1-T4 ONTO STACK	;[500]
;.POP4T -- POP T1-T4 FROM STACK		;[500]
;CALL:  PUSHJ	P,.PSH4T/.POP4T		;[500]
;USES NO ACS				;[500]

.PSH4T:	PUSH	P,T2		;[500] SAVE T2
	PUSH	P,T3		;[500] SAVE T3
	PUSH	P,T4		;[500] SAVE T4
	EXCH	T1,-3(P)	;[500] SAVE T1/GET RETURN
	PUSH	P,T1		;[500] PUT INTO SAFE PLACE
	MOVE	T1,-4(P)	;[500] RESTORE T1
	POPJ	P,		;[500] RETURN

.POP4T:	POP	P,T1		;[500] GET RETURN
	POP	P,T4		;[500] RESTORE T4
	POP	P,T3		;[500] RESTORE T3
	POP	P,T2		;[500] RESTORE T2
	EXCH	T1,(P)		;[500] RESTORE T1/SAVE RETURN
	POPJ	P,		;[500] RETURN

;IFN FTOPS20,	ENDMODULE

	END