Google
 

Trailing-Edge - PDP-10 Archives - -
There are no other files named in the archive.
COMMENT    VALID 00035 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00004 00002	
C00005 00003	HISTORY
C00010 00004	Discussion
C00013 00005	COMPIL(CAT,<CAT,CATCHR,CHRCAT,CHRCHR,CAT.RV>
C00021 00006	COMPIL(PTC,<PUTCH>,<GOGTAB,STRNGC,INSET>,<PUTCH -- PUT 1 CHARACTER ROUT>)
C00023 00007	COMPIL(PNT,<POINT,BBPP.>,<GOGTAB,X22,X44>,<POINT, BBPP.>)
C00024 00008	COMPIL(CVF,<CVF,CVG,CVE>
C00028 00009	   CVF,CVE,CVG CONTD.
C00031 00010	  CVF,CVG,CVE CONTD.
C00033 00011	  CVF,CVG,CVE CONTD.
C00035 00012	  CVF,CVG,CVE CONTD.
C00037 00013	COMPIL(SUB,<SUBST,SUBSR>,<SAVE,RESTR,X22,.SKIP.,GOGTAB>,<SUBSTRING ROUTINES>)
C00042 00014	COMPIL(EQU,<EQU>,<X44>,<EQU>)
C00044 00015	COMPIL(CVD,<CVD,CVO>,<SAVE,RESTR,X11,X22>,<CVD AND CVO ROUTINES>)
C00046 00016	COMPIL(CVS,<GETFORMAT,SETFORMAT,CVS,CVOS>
C00051 00017	COMPIL(SCC,<SCANC>,<GETBREAK,SETBREAK,RELBREAK,SCAN>,<SCANC ROUTINE>)
C00062 00018	COMPIL(CVC,<CVSIX,CVASC,CVSTR,CVXSTR,CV6STR,CVASTR>,<SAVE,RESTR,X11,X22,INSET,STRNGC,FLSCAN>
C00068 00019	COMPIL(CVL,<CVFIL>,<SAVE,RESTR,X22,X33,FILNAM,.SKIP.>,<CVFIL>)
C00070 00020	COMPIL(BRK,<BREAKSET,SETBREAK>
C00075 00021	Setbreak 
C00077 00022	COMPIL(SBK,<STDBRK>,<.SKIP.,OPEN,LOOKUP,GOGTAB,BKTCHK,ARRYIN,RELEASE,X22>,<STDBRK>)
C00084 00023	$print
C00091 00024	DSCR	PRINT routines
C00098 00025	DSCR $PRSTR -- final string printer
C00100 00026	DSCR
C00103 00027	DSCR	Utility routines for PRINT statement.
C00110 00028	ENDCOM(PRN)
C00111 00029	COMPIL(DVF,<CVEL>,<GOGTAB,STRNGC,SAVE,RESTR>,<LONG REAL TO STRING CONVERSION>)
C00113 00030	
C00117 00031	
C00120 00032	
C00123 00033	
C00125 00034	
C00127 00035	
C00130 ENDMK
C;
COMMENT HISTORY
AUTHOR,REASON
021  102100000060  ;


COMMENT 
VERSION 17-1(48) 11-13-74 BY JFR GETBREAK BUG P.21
VERSION 17-1(47) 11-7-74 BY RHT FEAT %BW% CV6STR
VERSION 17-1(46) 11-2-74 BY JFR MODS TO HANDLE BREAKTABLE 0(P.16)
VERSION 17-1(45) 10-26-74 BY JFR GETBREAK
VERSION 17-1(44) 10-26-74 BY JFR BUG #TP GETBREAK FIXES
VERSION 17-1(43) 10-14-74 BY JFR CHECK FOR HACK'S--NONE FOUND
VERSION 17-1(42) 10-13-74 BY JFR FIX MINOR LOSSAGE IN SCAN
VERSION 17-1(41) 10-13-74 BY    
VERSION 17-1(40) 10-11-74 BY JFR CORRECT TYPOS %BS%
VERSION 17-1(39) 10-11-74 BY JFR INSTALL GETBREAK, RELBREAK
VERSION 17-1(38) 10-11-74 
VERSION 17-1(37) 10-11-74 BY JFR BETTER ERROR TRACING FOR %BS% BKTCHK
VERSION 17-1(36) 10-11-74 BY JFR FEAT %BS% (SECOND HALF) NEW WAY TO DO BREAK TABLES
VERSION 17-1(35) 10-10-74 BY JFR FEAT %BS% (FIRST HALF) NEW WAY TO DO BREAK TABLES
VERSION 17-1(34) 10-10-74 
VERSION 17-1(33) 10-10-74 
VERSION 17-1(32) 10-10-74 
VERSION 17-1(31) 10-10-74 
VERSION 17-1(30) 10-10-74 
VERSION 17-1(29) 9-16-74 BY RHT BUG #TH# OVERFLOW IN SCAN
VERSION 17-1(28) 9-8-74 BY RHT BUG #TF# NEW SCAN LOSING WHEN NO BRK CHR
VERSION 17-1(27) 7-29-74 BY RHT BUG #SW# NEW SCAN PROBLEM
VERSION 17-1(26) 7-19-74 BY RHT FEAT %BK% MAKE SCAN BETTER FOR NON-OMIT CASE
VERSION 17-1(25) 5-30-74 BY RHT FIX UP SOME COMPILS
VERSION 17-1(24) 5-29-74 BY RHT FIX STDBRK
VERSION 17-1(23) 5-25-74 BY RLS EDIT
VERSION 17-1(22) 5-25-74 BY rls edit
VERSION 17-1(21) 5-25-74 BY rls edit
VERSION 17-1(20) 5-25-74 
VERSION 17-1(19) 5-25-74 BY RLS EDIT
VERSION 17-1(18) 5-24-74 BY RLS EDIT
VERSION 17-1(17) 5-24-74 BY RLS MAKE STDBRK SYSTEM INDEPENDENT
VERSION 17-1(16) 5-24-74 
VERSION 17-1(15) 5-24-74 BY rht move some routines over from ioser
VERSION 17-1(14) 5-24-74 
VERSION 17-1(13) 5-24-74 
VERSION 17-1(12) 5-24-74 
VERSION 17-1(11) 5-24-74 
VERSION 17-1(10) 5-24-74 
VERSION 17-1(9) 5-24-74 
VERSION 17-1(8) 5-24-74 
VERSION 17-1(7) 1-13-74 BY JRL BUG QI CVO DIDN'T WORK WITH INTERRUPTS ENABLED
VERSION 17-1(6) 1-13-74 
VERSION 17-1(5) 12-14-73 BY RFS BUG #QB# MAKE CVG DO LARGEST NEG RIGHT
VERSION 17-1(4) 12-8-73 BY JRL REMOVE SPECIAL STANFORD CHARACTERS(WHERE POSSIBLE)
VERSION 17-1(3) 11-28-73 BY RLS BUG #PG# CVS OF '400000000000
VERSION 17-1(2) 11-28-73 
VERSION 17-1(1) 11-25-73 BY RHT BUG #LA# MAKE CVSIX HONEST
VERSION 17-1(14) 7-26-73 BY RHT **** VERSION 17 ****
VERSION 16-2(13) 3-18-73 BY RHT PROTECT RPH FROM USERERR 
VERSION 16-2(12) 5-11-72 BY DCS BUG #GY# BE SURE ALIGNED IF SGLIGN & ALREDY CATED
VERSION 15-2(6-11) 5-11-72 
VERSION 15-2(5) 2-8-72 BY DCS BUG #GL# -- CANCEL SAME -- COULDN'T GET RIGHT
VERSION 15-2(4) 2-6-72 BY DCS BUG #GL# CVF, CVG, CVE DON'T PUT OUT EXTRA SPACE WHEN NON-NEGATIVE
VERSION 15-2(3) 2-5-72 BY DCS BUG #GI# OPTIMIZE CAT, REMOVE TOPSTR
VERSION 15-2(2) 12-21-71 BY DCS BUG #FS# REMOVE SAILRUN CONDITIONAL
VERSION 15-2(1) 12-2-71 BY DCS INSTALL VERSION NUMBER

;
SUBTTL	Discussion
	LSTON	(STRSER)
DSCR BEGIN STRSER

IFN ALWAYS,<BEGIN STRSER>

DSCR STRSER DISCUSSION


Comment  These routines manipulate entities known to
	SAIL/GOGOL users as STRINGS. A string is described by
	a two-word string descriptor with the following format:
   WD1:	string no,,# of characters
   WD2:	byte pointer to string

String no. is incremented whenever a new string is created at
	the top of string space. (SUBSTR does not increment it).  An
	ILDB on WD2 gets the first character of the string.

All parameters necessary for string operations are in the user's
	parameter table (GOGTAB pnts  at it):
  TOPBYTE: byte pointer to next available character
  REMCHR:  negative count of free characters remaining
  ST:	   addr of first string space word
  STTOP:   addr of last word.

STRNGC is the compacting string garbage collector, called when not
	enough space remains. The number of characters desired by the
	operation detecting the lack is in register A on entry.

Strings are concatenated by copying both operands to the top
	of string space (or only the 2nd if the first is already
	on top), and creating a descriptor for the new string.  
	SUBSTR operations simply create new descriptors.
	GETCH and PUTCH handle numeric to string conversions (vice-versa)

COMPIL(CAT,<CAT,CATCHR,CHRCAT,CHRCHR,CAT.RV>
	  ,<SAVE,RESTR,X22,X33,STRNGC,INSET,GOGTAB,CONFIG,PUTCH>
	  ,<CAT -- CONCATENATION ROUTINE>)

;;#GI# DCS 2-5-72 OPTIMIZE CAT SOME MORE, REMOVE TOPSTR
DSCR "STRING"_CAT("STR1","STR2");
CAL SAIL
DES CALL GENERATED BY COMPILER FOR & OPERATOR

	
DEFINE CANON (ADR,AC)<
	LDB	TEMP,[POINT 3,ADR,5]	;4,5,6,7,0,1 FROM POSITION
	IMULI	AC,5			;ADDR IN CHARS
	ADD	AC,BPTBL(TEMP)		;0,1,2,3,4,5 EXTRA CHARS
>

;CAT'S MAP TABLE

BPTBL:	4
	5
	0
	0
	0
	1
	2
        3				;MAP

HERE (CAT.RV)
	POP	SP,TEMP			;ARGUMENTS ARE IN REVERSE ORDER,
	POP	SP,LPSA			; PUT THEM RIGHT
	PUSH	SP,-1(SP)
	PUSH	SP,-1(SP)
	MOVEM	LPSA,-3(SP)
	MOVEM	TEMP,-2(SP)

HERE (CAT)
	MOVE	USER,GOGTAB
	POP	P,UUO1(USER)		;SAVE FOR STRNGC ERR MESSAGE
	MOVEI	TEMP,-1			;FOR TESTING LENGTHS
	TDNN	TEMP,-3(SP)		;FIRST STRING NULL?
	 JRST	 RETSEC			;YES, RETURN SECOND STRING
	TDNN	TEMP,-1(SP)		;SECOND STRING NULL?
	 JRST	 RETFRS			;YES, RETURN FIRST STRING
CATGO:	MOVEI	TEMP,RACS(USER)
	BLT	TEMP,RACS+3(USER)
	MOVEM	RF,RACS+RF(USER)	;SAVE F-REGISTER

CATGO1:	HRRZ	B,-2(SP)		;ADDR WORD OF FIRST STRING
	MOVE	LPSA,B
	CANON	(<-2(SP)>,LPSA)		;COMPUTE CANONICAL FORM
	HRRZ	A,-3(SP)		;#CHARS IN FIRST
	ADD	LPSA,A			;+#CHARS IN FIRST
	HRRZ	C,(SP)			;2D ADDRESS
	CAMGE	C,B			;IS IT POSSIBLE THEY ARE ALREADY CAT?
	 JRST	 CAT3			;NO
	CANON	(<(SP)>,C)		;GET CANONICAL FORM OF 2D
	CAMN	C,LPSA			;SAME?
	 JRST	 ADJRET			;YES, RETURN ADJUSTED POINTER
CAT3:	HRRZ	C,TOPBYTE(USER)		;TRY SAME TRICK WITH THIS GUY
	CANON	(<TOPBYTE(USER)>,C)
	CAMN	C,LPSA			;FIRST AT THE TOP?
	 JRST 	 ONLY1			;YES	

; TWO STRINGS TO MOVE

MOVTWO:	ADD	A,-1(SP)	;#CHARS(2)
	HRRZ	A,A		;ALLOW ROOM FOR POSSIBLE INSET
	ADDM	A,REMCHR(USER)	;#CHARS(NEW) - REMAINING #CHARS
	SKIPLE	REMCHR(USER)	;ENOUGH ROOM?
	PUSHJ	P,STRNGC	;NO, GO MAKE SOME
	SKIPE	SGLIGN(USER)	;IF ALIGNING,
	PUSHJ	P,INSET		; ALIGN
	HRRZ	B,-3(SP)	;GET 1ST # CHARS
	HRROM	A,-3(SP)	;COUNT RESULT
	MOVE	LPSA,TOPBYTE(USER);WILL BE NEW BYTE POINTER
	MOVE	A,LPSA		;WILL BE RESULT
	EXCH	A,-2(SP)	;TRADE WITH FIRST BYTE POINTER
	ILDB	C,A		;KNOWN NOT TO BE NULL STRING
	IDPB	C,LPSA		;MOVE THE STRING
	SOJG	B,.-2		;RAPIDLY
	HRRZ	A,-1(SP)	;#CHARS(2)
	JRST	CATB


;  ONLY ONE STRING TO MOVE

ONLY1:	SKIPE	SGLIGN(USER)	;CHECK ALIGNMENT?
;;#GY# SEE JUST BELOW
	JSP	C,CHKLGN	;YES, DON'T RETURN IF MISALIGNED
;;#GY#
;;#QE#	DCS 12-30-73 Avoid problems when STRNGC expands
	HRRZ	A,-1(SP)	;#CHARS(2)
	ADDM	A,REMCHR(USER)	; - REMAINING CHARS
	SKIPLE	REMCHR(USER)	;ROOM?
;	PUSHJ	P,STRNGC	;NO
	JRST	[PUSHJ	P,STRNGC	;no, collect, then start from scratch
		MOVNS	A		;since new string space may void
		ADDM	A,REMCHR(USER)	;the ONLY1 condition.
		JRST	CATGO1]		;CATGO1 is new for this fix.
;;#QE#
	ADDM	A,-3(SP)	;NEW #CHARS
	MOVE	LPSA,TOPBYTE(USER);EXTEND FROM HERE

;  MOVE 2D

CATB:	MOVE	B,(SP)		;2D BYTE POINTER
	ILDB	C,B		;MOVE THIS STRING
	IDPB	C,LPSA		;AND MOVE IT
	SOJG	A,.-2		; FAST
	MOVEM	LPSA,TOPBYTE(USER);PUT THIS AWAY, BY ALL MEANS
REST.4:	MOVSI	TEMP,RACS(USER)
	BLT	TEMP,C
RETFRS:	SUB	SP,X22		;REMOVE NON-RESULT
	JRST	@UUO1(USER)	;RETURN

RETSEC:	POP	SP,-2(SP)
	POP	SP,-2(SP)
	JRST 	@UUO1(USER)	;DIDN'T SAVE THEM

;;#GY# DCS 5-11-72 ASSURE FULL-WORD ALIGN IF SGLIGN AND ALREADY CATTED
ADJRET:	SKIPE	SGLIGN(USER)	;IF NEED ALIGNMENT, MUST CHECK IT
	 JSP	 C,CHKLGN	;DON'T RETURN IF NOT ALIGNED
OKLG:	HRRZ	TEMP,-1(SP)	;COUNT OF 2D
	ADDM	TEMP,-3(SP)	;INCREASE COUNT OF FIRST
	JRST	REST.4

CHKLGN:	MOVE	TEMP,-2(SP)	;Check the position field of first arg --
	TLNN	TEMP,300000	;44, 01 are aligned, 35,27,17,10 not.  Bits
	 JRST	 (C)		; 1 and 2 are both off only for 44 and 01.
	 JRST	 MOVTWO		;Not aligned, move both
;;#GY#

DSCR "STRING"_CHRCAT(CHAR,"STR")

HERE (CHRCAT)
	HRRZ	TEMP,-1(SP)	;CHECK OTHER STRING NULL
	JUMPE	TEMP,ITSNUL
	PUSH	SP,-1(SP)	;MAKE ROOM FOR ONE UNDERNEATH
	PUSH	SP,-1(SP)
	MOVEI	TEMP,-4(SP)	;NOW PUT SINGLE-CHAR STRING
	PUSH	TEMP,[ONECH: 1
		      POINT 7,RACS+5(USER),27] ;CONSTANT IN
	PUSH	TEMP,ONECH+1
	JRST	CATCGO		;GO DO SPECIAL CAT

DSCR "STRING"_CATCHR("STR",CHAR)

HERE (CATCHR)
	HRRZ	TEMP,-1(SP)
	JUMPE	TEMP,ITSNUL
	PUSH	SP,ONECH	;PUT ONE-CHAR DESCRIPTOR ON
	PUSH	SP,ONECH+1	;TOP
CATCGO:	MOVE	USER,GOGTAB
	POP	P,UUO1(USER)	;RETURN ADDRESS
	POP	P,TEMP		;PUT IT SOMEWHERE SAFE
	ADD	TEMP,TEMP
	MOVEM	TEMP,RACS+5(USER)
	JRST	CATGO		;EVERYBODY'S NON-NULL
	
ITSNUL:	SUB	SP,X22
	JRST	PUTCH		;ZAP

DSCR "STRING"_CHRCHR(CHAR,CHAR)

HERE (CHRCHR)
	MOVE	USER,GOGTAB
	MOVEM	RF,RACS+RF(USER)
	PUSH	P,A
	MOVEI	A,2		;NEED 2 CHARS
	ADDM	A,REMCHR(USER)
	SKIPLE	A,REMCHR(USER)
	 PUSHJ	 P,STRNGC	;THE USUAL
	MOVE	A,-3(P)		;CHAR 1
	EXCH	A,(P)		;GET BACK SAVED
	PUSHJ	P,PUTCH		;A STRING
	AOS	-1(SP)		;2 CHARACTER STRING
	MOVE	TEMP,-1(P)	;CHAR 2
	IDPB	TEMP,TOPBYTE(USER);A 2-CHAR STRING
	SUB	P,X33
	JRST	@3(P)		;QUICK AS A BUNNY

;;#GI#

ENDCOM (CAT)
COMPIL(PTC,<PUTCH>,<GOGTAB,STRNGC,INSET>,<PUTCH -- PUT 1 CHARACTER ROUT>)

DSCR "1-CHR STRING"_PUTCH(INTEGER);
CAL SAIL
DES CALL GENERATED BY SAIL TO MAKE A 1 CHAR STRING FROM AN INTEGER


HERE(PUTCH)	
	MOVE	USER,GOGTAB
	MOVEM	RF,RACS+RF(USER)
	SKIPE	SGLIGN(USER)
	PUSHJ	P,INSET		;START ON FW BDRY
	POP	P,UUO1(USER)
	PUSH	P,A		;SAVE A
	MOVEI	A,1		;COUNT FOR STRNGC
	AOSLE	REMCHR(USER)	;DECREASE FREE CHARS
	PUSHJ	P,STRNGC	; NO
	POP	P,A		;RESTORE A
	POP	P,TEMP		;GET CHARACTER
	PUSH	SP,[XWD 40,1]	;#CHARS
	PUSH	SP,TOPBYTE(USER);HERE'S WHERE IT GOES
	IDPB	TEMP,TOPBYTE(USER) ;STORE CHAR, UPDATE TOPBYTE(USER)
	JRST	@UUO1(USER)	;RETURN

ENDCOM (PTC)
COMPIL(PNT,<POINT,BBPP.>,<GOGTAB,X22,X44>,<POINT, BBPP.>)

; GETCH AND LOP NOW DONE IN LINE, NO LONGER NEEDED

HERE (BBPP.)
HERE (POINT) MOVEI	A,43		;GET LOW BIT
	SUB	A,-1(P)
	ROT	A,-6		;NOW IN HIGH BITS
	MOVE	TEMP,-3(P)	;BYTE SIZE
	DPB	TEMP,[POINT 6,A,11]
	HRR	A,-2(P)		;EFFECTIVE ADDRESS.
	SUB	P,X44
	JRST	@4(P)

ENDCOM(PNT)
COMPIL(CVF,<CVF,CVG,CVE>
	  ,<SAVE,STRNGC,RESTR,X22,X11,X33,.MT.,.CH.,.TEN.>
	  ,<CVF, CVG, CVE>)

DSCR "STRING"_CVF(REAL);
CAL SAIL


HERE (CVF)	PUSHJ P,SAVE
	PUSH P,[-1]
	JRST SSCONV

DSCR "STRING"_CVG(REAL);
CAL SAIL


HERE (CVG)	PUSHJ P,SAVE
	PUSH P,[1]
	JRST SSCONV

DSCR "STRING"_CVE(REAL);
CAL SAIL


HERE (CVE)	PUSHJ P,SAVE
	PUSH P,[0]
	JRST SSCONV

	BEGIN NUMOUT
^SSCONV:MOVE LPSA,X33
	PUSHJ P,BOUND

;BOUND RETURNS AN INTEGER IN B WHICH WILL CONVERT
;TO 8 DECIMAL DIGITS.
;AN EXPONENT OF TEN IN D AND THE SIGN OF THE NUMBER IN FF
	MOVM X,DIGS(USER)	;NUMBER OF DECIMALS
	SKIPGE (P)		;IF F FORMAT
	ADD X,D			;ADD THE TEN EXPONENT
	JUMPN B,E0
	JUMPN X,E0
	MOVEI A,2
	SKIPL (P)
	MOVEM A,(P)
E0:	JUMPGE X,E1
	MOVEI	B,0		;THIS FIXES A BUG
	JRST E2
E1:	CAIL X,10
	JRST E2
	MOVEI Y,10		; 0  LEQ  X LESS THAN 8
	SUB Y,X			;Y IS THE EXPONENT OF DIVISOR
	MOVE Z,.TEN.(Y)		;Z IS THE DIVISOR
	IDIV B,Z
	ASH Z,-1
	CAML C,Z
	AOJ B,			;ROUND
	CAMGE B,.TEN.(X)		;CHECK IF ROUND CAUSED ANOTHER DIGIT
	JRST E2
	SKIPGE (P)		;IF F FORMAT
	AOJA X,E2		;INCREASE DIGIT COUNT
	IDIVI B,=10		;OTHERWISE REMOVE IT
	AOJ D,			;AND INCREASE EXPONENT
E2:	MOVM A,DIGS(USER)
	CAMGE A,X
	MOVE A,X		;A CONTAINS NUMBER OF DIGITS
	ADDI A,2		;SIGN AND DECIMAL POINT
	SKIPL (P)
	ADDI A,4		;IF NOT F FORMAT @-DD
	MOVE Z,A		;SAVE CHARACTER COUNT
	MOVM Y,WDTH(USER)	;MINIMUN STRING LENGTH
	CAMG A,Y
	MOVE A,Y

; THE STRING GARBAGE COLLECTOR GOODIES

	ADDM A,REMCHR(USER)	;CHECK THERE IS ROOM
	SKIPLE REMCHR(USER)
	PUSHJ P,STRNGC		;NO ROOM
	HRRO C,A		;NON-ZERO, WITH COUNT
	PUSH SP,C
	PUSH SP,TOPBYTE(USER)

; INSERT LEADING SIGNS, BLANKS, ZEROES

	SUB A,Z			;NUMBER OF LEADING SPACES
;;#GL# DCS 2-6-72 (1-1) EXTRA CHAR ONLY IF NEG. AND NO PADDING POSSIBLE
;;#GL# CANCELLED 2-8-72 BECAUSE I COULDN'T FIGURE IT ALL OUT
	MOVEI C," "
	JUMPE A,E4		;NO LEADING SPACES
	SKIPL WDTH(USER)	;F FORMAT
	JRST E3
;; #GL#
	JUMPE FF,.+2		;LEADING ZEROS - NO SIGN, GO DO ZEROES
	MOVEI C,"-"
	IDPB C,TOPBYTE(USER)
	MOVEI C,"0"
E5:	IDPB C,TOPBYTE(USER)	;FILL WITH ZEROS
	SOJG A,E5
	JRST C1
E3:	IDPB C,TOPBYTE(USER)	;FILL WITH BLANKS
	SOJG A,E3
;; #GL#
E4:	JUMPE FF,.+2		;NO SIGN, BLANKS ALL DONE
;;#GL#
	MOVEI C,"-"		;THEN THE SIGN
	IDPB C,TOPBYTE(USER)
;   CVF,CVE,CVG CONTD.

C1:	MOVEI Z,10
	SKIPL (P)
	JRST C6
	MOVE Y,X		;CVF NUMBER OF DIGITS
	MOVM A,DIGS(USER)	;NUMBER OF DECIMALS
	SUB Y,A			;POS OF DECIMAL POINT
	JUMPGE Y,C5		;IF POSITIVE
	SUB Z,Y
	MOVM X,DIGS(USER)
	SETZ Y,			;OTHERWISE ZERO
	JRST C5
C6:	SETZ Y,
	SKIPG (P)
	JRST C5
	JUMPL D,C5		;CVG IF NEG TAKE CVE
	CAMLE D,X		;IF ENOUGH DIGITS 
	JRST C5
	MOVE Y,D		;SHIFT DECIMAL POINT
	MOVEI	D,0		;AND ADJUST EXPONENT
C5:	PUSH P,[D1]		;RECURSIVE NUMBER PRINTER
C2:	CAIE X,(Y)		;DECIMAL POINT NOW 
	JRST C3
	SOJ Z,
	MOVEI C,"."		;YES
	SKIPE DIGS(USER)	;IF ZERO DIGITS
	JRST C4
	JUMPN B,C4
	MOVEI C," "
	SKIPL -1(P)
	JRST C9
	SOJA X,C3
C9:	MOVE Y,-1(P)
	CAIE Y,2
	JRST C4
	POP P,Y
	MOVE Y,[ASCII/ 0   /]
	JRST D8
C3:	CAILE X,(Z)		;IF MORE THAN 8 DIGITS
	JRST	[MOVEI C,"0"	;PUSH A ZERO
		JRST C4]
	IDIVI B,=10
	IORI C,"0"
C4:	HRLM C,(P)
	SOSL X
C8:	PUSHJ P,C2
C7:	HLRZ C,(P)		;PUSH NUMBER OUT
	IDPB C,TOPBYTE(USER)
	POPJ P,
D1:	SKIPGE (P)
	JRST D7
	SKIPN DIGS(USER)
	SOJA D,D2
	JUMPE D,	[MOVE Y,[ASCIZ /    /] ;EXPONENT ZERO SO STORE 
			JRST D8]		;FOUR BLANKS
D2:	SETZ Y,			;ACCUMULATE EXPONENT STRING
	SETZ FF,		;EXPONENT SIGN
	JUMPL D,	[SETO FF,	;NEGATIVE
			MOVN D,D	;MAKE POSITIVE
			JRST D4]
	HRLI Y," "=11		;NUMBER POS SO TRILING BLANK
D4:	CAIGE D,=10
	JRST 		[MOVEI X," "
			LSHC X,-7
			JRST D5]
D5:	IDIVI D,=10
	IORI X,"0"
	LSHC X,-7		;PUSH INTO Y
	JUMPG D,D5
;;%DY% 2! GJA/JFR 1-13-77
	SKIPN X,EXPCHR(USER)	;WHAT THE LOSER WANTED
	 MOVEI X,"@"		;NOT THERE, USE DEFAULT
	IDPB X,TOPBYTE(USER)
	MOVEI X,"-"		;MINUS SIGN
	SKIPE FF
D6:	IDPB X,TOPBYTE(USER)	;AND EXPONENT
	JUMPE Y,D7
D8:	LSHC X,7
	JRST D6
D7:	JRST RESTR		; RETURN
;  CVF,CVG,CVE CONTD.

BOUND:	SETZB FF,D		;TENS EXPONENT
	MOVE B,-3(P)		;INPUT NUMBER
	JUMPE B,ZERO
	JUMPG B,POS
;;#QB# RFS MAKE LARGEST NEG NUMBER WORK
	SETOB FF,A		;NUM IS NEG
	LSHC A,11		;SEPERATE BIN EXPONENT
	LSH B,-1
	SETCA A,		;BIN EXPONENT + 200
	JUMPE B,LARN		;LARGEST NEGATIVE???
	TLO B,400000		;
	MOVNS B
	JRST OK
LARN:	HRLOI B,177777		; LARGEST NEG SHIFTED RIGHT 1 BIT
	AOJA A,OK
;;#QB#
POS:	SETZ A,
	LSHC A,11		;SEPERATE BIN EXPONENT
	LSH B,-1
OK:	SUBI A,200		;BIN EXP IN A, ABS (BIN FRACT) IN B,
	;BINARY POINT LEFT OF BIT 1 SIGN OF NUMBER IN FF
	CAIL A,34
	JRST MULTI		;USE NEGATIVE POWERS OF TEN
	CAIG A,27		;N LESS THAN 34
	JRST FRACT		;USE POSITIVE POWERS OF TEN
	CAIL A,33		;30.2 LEQ N LESS THAN 34
	JRST TOPQ
	CAIG A,30		;30.2 LEQ N LESS THAN 33
	JRST BOT
DONE:	SUBI A,43		;31.2 LEQ N LESS THAN 33
	ASHC B,(A)
	TLNE C,200000		;ROUND
	AOJ B,
	ADDI D,10
ZERO:	POPJ P,
TOPQ:	CAMLE B,MF		;33.2 LEQ N LESS THAN 34
	JRST MULTI 		;33.276 LESS THAN N LESS THAN 34
	JRST DONE		;33.2 LEQ N LEQ 33.276
BOT:	CAMGE B,LF		;30.2 LEQ N LEQ 30
	JRST FRACT		;30.2 LEQ N LESS THAN 30.230
	JRST DONE		;30.230 LEQ N LESS THAN 30
;  CVF,CVG,CVE CONTD.

MULTI:	MOVEI X,13		;33.276 LESS THAN N
M2:	ASH D,1
	ADD A,.CH.(X)		;NEGATIVE POWERS OF TEN
	CAIG A,31
	JRST M1			;N LESS THAN 32
	PUSHJ P,LFMP		;31.2 LESS THAN N
M6:	IORI D,1		;SET EXPONENT BIT
	CAIL A,34
	SOJA X,M2		;35.2 LESS THAN N STILL TOO LARGE
	CAIE A,33		;31.2 LESS THAN N LESS THAN 34
	JRST M3			;31.2 LESS THAN N LESS THAN 33
	CAMLE B,MF		;33.2 LESS THAN N LESS THAN 34
	JRST M4			;33.276 LESS THAN N LESS THAN 34
M3:	ASH D,-6(X)		;33.2 LESS THAN N LEQ 33.276
	JRST DONE
M1:	CAIL A,30		;N LESS THAN 32
	JRST M5			;29.2 LESS THAN N LESS THAN 32
M8:	SUB A,.CH.(X)		;N LESS THAN 30 NO GOOD
	SOJA X,M2		;TRY NEXT POWER
M4:	CAIE X,6		;33.276 LESS THAN N LESS THAN 34
	SOJA X,M2
	MOVE B,MF		;33.276=N
	JRST DONE
M5:	MOVE Y,B		;SAVE B AND A
	MOVE Z,A
	PUSHJ P,LFMP
	CAIL A,31		;29.2 LESS THAN N LESS THAN 32
	JRST M6			;31.2 LESS THAN N LESS THAN 32
	CAIG A,27		;29.2 LESS THAN N LESS THAN 31
	JRST M7			;29.2 LESS THAN N LESS THAN 30
	CAML B,LF		;30.2 LESS THAN N LESS THAN 31
	JRST M6			;30.230 LESS THAN N LESS THAN 31
	CAILE X,6		;30.2 LESS THAN N LESS THAN 30.230
	JRST M7			;STILL SOME TO GO
	MOVE B,LF		;B=30.230
	JRST M6
M7:	MOVE B,Y		;RESTORE
	MOVE A,Z
	JRST M8
;  CVF,CVG,CVE CONTD.

FRACT:	MOVEI X,5		;N LESS THAN 30.230
L2:	ASH D,1
	ADD A,.CH.(X)
	CAIL A,33
	JRST L1			;32.2 LEQ N
	PUSHJ P,LFMP		;N LESS THAN 33
L6:	IORI D,1
	CAIGE A,30
	SOJA X,L2		;N LESS THAN 30
	CAIE A,30		;30.2 LEQ N LESS THAN 33
	JRST L3			;31.2 LEQ N LESS THAN 33
	CAMGE B,LF		;30.2 LEQ N LESS THAN 31
	JRST L4			;30.2 LEQ N LESS THAN 30.230
L3:	ASH D,(X)		;30.2300 LEQ N LESS THAN 31
L9:	MOVNS D
	JRST DONE
L1:	CAIG A,34		;32.2 LEQ N
	JRST L5			;32.2 LEQ N LESS THAN 35
L8:	SUB A,.CH.(X)		;34.2 LEQ N
	SOJA X,L2
L4:	SOJGE X,L2		;30.230 LEQ N LESS THAN 31
	MOVE B,LF		;N30.230
	JRST L9
L5:	MOVE Y,B		;SAVE B AND A
	MOVE Z,A
	PUSHJ P,LFMP
	CAIG A,32		;32.2 LEQ N LESS THAN 35
	JRST L6			;32.2 LEQ N LESS THAN 33
	CAIL A,34		;33.2 LEQ N LESS THAN 35
	JRST L7			;34.2 LEQ N LESS THAN 35
	CAMG B,MF		;33.2 LEQ N LESS THAN 34
	JRST L6			;33.2 LEQ N LESS THAN 34
	JUMPG X,L7		;33.276 LESS THAN N LESS THAN 34
	MOVE B,MF		;N=33.276
	JRST L6
L7:	MOVE B,Y		;RESTORE
	MOVE A,Z
	JRST L8
LFMP:	MUL B,.MT.(X)
	TLNE B,200000
	POPJ P,
	ASHC B,1
	SOJA A,.+1
	POPJ P,
LF:	230455000000
MF:	276570177400
	BEND

ENDCOM(CVF)
COMPIL(SUB,<SUBST,SUBSR>,<SAVE,RESTR,X22,.SKIP.,GOGTAB>,<SUBSTRING ROUTINES>)

DSCR "STRING"_SUBST("STRING",END CHAR,STARTING CHAR);
CAL SAIL
DES CALL GENERATED BY SAIL FOR STR[X FOR Y] OPERATION


HERE (SUBST)
	MOVE	LPSA,-2(P)		;END LOC
	JRST	SBSTR			;GO FINISH UP

; SUBSI NO LONGER NEEDED, REMOVED

DSCR "STRING"_SUBSR("STRING",#CHARS, START CHAR #);
CAL SAIL
DES CALL GENERATED BY SAIL FOR STR[X TO Y] OPERATION
 ALGORITHM IS AS FOLLOWS:
 	1) !SKIP!_FALSE; "NOSKIP" IF ALL OK
<	2) IF END LOC > LENGTH, REPLACE IT BY LENGTH, (RH(!SKIP!)_TRUE;
 	3) NOW IF START < 1 OR END-START < -1 (-1 means ZERO LENGTH REQUEST),>>
		LH(!SKIP!)_TRUE, SET START TO 1 OR LENGTH+1
 	4) ADJUST LENGTH AND BP IN DESCRIPTOR
 NOTICE THAT STR[INF+1 TO INF+1+(non-neg integer)] IS LEGAL, RETURNING NULL,
 	AND TURNING ON !SKIP!


HERE (SUBSR)
	SOS	LPSA,-2(P)		;#CHARS
	ADD	LPSA,-1(P)		;-1 + START = END

SBSTR:	MOVE	TEMP,GOGTAB		;FOR A MOMENT
	POP	P,UUO1(TEMP)		;SAVE RETURN -- NONSTANDARD!!
	SETZM	.SKIP.			;ASSUME ALL OK
	MOVE	USER,(P)		;START LOC
	HRRZ	TEMP,-1(SP)		;LENGTH OF STRING
	JUMPL	LPSA,[     TDZA LPSA,LPSA ;END LOC CANNOT BE NEGATIVE
		      NO4: MOVE LPSA,TEMP ;NOR GREATER THAN LENGTH
			   HLLOS .SKIP.   ;TELL THE USER END WAS WRONG
			   JRST  OKS1]
	CAMLE	LPSA,TEMP		;END LOC CANNOT BE GREATER THAN LENGTH
	 JRST	 NO4
OKS1:	CAIL	USER,1(LPSA)		;NEW STRING MUST HAVE NON-NEG LENGTH
	 JRST	 NO1			;ADJUST TO 1(LPSA)
	JUMPLE	USER,[NO2:	MOVEI USER,1	;NON-POS, ADJUST TO 1
				JRST NO3
			NO1:	MOVEI USER,1(LPSA) ;1 PAST END OF REQUEST
			NO3:	HRROS .SKIP.	   ;TELL USER START IS BAD
				JRST  OKS]	   ;NOW CAN DO SUBSTRING
OKS:	SUBI	LPSA,-1(USER)		;NEW STRING LENGTH
	HRRM	LPSA,-1(SP)		;GET RID OF IT, FORGET IT
	MOVE	LPSA,(SP)		;BP
	LDB	TEMP,[POINT 3,LPSA,5]
	TRC	TEMP,4			;# CHARS FROM BEG OF CURRENT BP
	ADDI	TEMP,-1(USER)		;+ # ADDITIONAL CHARS DUE TO SUBSTR
	CAILE	TEMP,4			;CAN WE AVOID DIV OR SUB?
	 JRST	 DIVSUB			;NO
GETPTF:	HLL	LPSA,PTBL(TEMP)		;GET POINTER AND SIZE FIELDS
PTWAY:	MOVEM	LPSA,(SP)		;RESULT BP
	SUB	P,X22			;RID SELF OF ARGUMENTS
	JRST	@3(P)			;RETURN

DIVSUB:	CAILE	TEMP,9			;CAN WE AVOID DIV?
	 JRST	 DIV			;NO
	SUBI	TEMP,5			;PUT # IN RANGE 0 TO 4
	ADDI	LPSA,1			;INCREMENT BP
	JRST	GETPTF			;FINISH UP

; N.B. -- LPSA=13, TEMP=14, USER=15 -- CHANGE THIS CODE IF YOU MODIFY THESE
;  ASSIGNMENTS

DIV:	IDIVI	TEMP,5			;# WORDS TO USER, # CHARS TO TEMP
	ADD	LPSA,TEMP		;INCREMENT BP ADR FIELD
	HLL	LPSA,PTBL(USER)		;GET POINTER AND SIZE FIELDS
	JRST	PTWAY			;FINISH UP

PTBL:	POINT	7,0
	POINT	7,0,6			;POINTER AND SIZE FIELDS FOR 7-BIT BYTES
	POINT	7,0,13
	POINT	7,0,20
	POINT	7,0,27
	POINT	7,0,35


ENDCOM (SUB)
COMPIL(EQU,<EQU>,<X44>,<EQU>)

DSCR BOOLEAN_EQU("STR1","STR2");
CAL SAIL


HERE (EQU)	
; NOTE USER NOT SET UP BECAUSE CAN BE NO ERROR MESSAGES
	PUSH	P,B		;SAVE EXTRA AC
	HRRZ	A,-1(SP)	;LENGTH OF ONE STRING
	HRRZ	B,-3(SP)	;LENGTH OF THE OTHER
	CAME	A,B		;SAME?
	 JRST	 NOTEQ		; NO, NOT EQUAL STRINGS
	MOVE	LPSA,(SP)	;ONE BYTE POINTER
	MOVE	USER,-2(SP)	;THE OTHER
	JRST	CLUP1		;ENTER THE LOOP AT ITS BASE
CLUP:	ILDB	TEMP,LPSA	;ONE CHAR
	ILDB	B,USER		;ANOTHER
	CAMN	TEMP,B		;QUIT IF NOT EQUAL
CLUP1:	SOJGE	A,CLUP		;CONTINUE UNTIL ALL PERUSED OR SOME NOT EQUAL
	JUMPL	A,.+2		;IF -1, THEY'RE EQUAL, USE -1 TO BE TRUE
NOTEQ:	MOVEI	A,0		;NOT EQUAL
	POP	P,B		;RESTORE AC
	SUB	SP,X44		;GET RID OF ARGS
	POPJ	P,		;RETURN

ENDCOM (EQU)
COMPIL(CVD,<CVD,CVO>,<SAVE,RESTR,X11,X22>,<CVD AND CVO ROUTINES>)

DSCR INTEGER_CVD("STRING");
CAL SAIL


HERE (CVD)	
	PUSHJ	P,SAVE
	MOVEI	A,=10
	JRST	CV

DSCR INTEGER_CVO("STRING");
CAL SAIL


HERE (CVO)	
	PUSHJ	P,SAVE
	JOV	.+1		;CLEAR ANY OVERFLOWS
	MOVEI	A,10
CV:	SETZB	B,Y		;COLLECT RESULT IN B, Y IS +/- FLAG
	MOVE	LPSA,X11
	HRRZ	C,-1(SP)	;STRING COUNT
	MOVE	D,(SP)		;BYTE POINTER
CVL:	SOJL	C,CVDUN
	ILDB	X,D		;GET A CHAR
	CAIG	X," "		;IGNORE LEADING " "s  AND SUCH
	 JRST	 CVL
	CAIN	X,"-"		;NEGATIVE?
	TLCA	Y,10000		;NEGATE PREVIOUS NOTION
	CAIN	X,"+"		;PLUS?
	 JRST	 CVL		; GO BACK FOR MORE LEADING "BLANKS"

; NOW IT IS A DIGIT OR THE END

CNV:	CAIL	X,"0"		;IN RANGE?
	CAIL	X,"0"(A)	;A IS RADIX
	 JRST	 CVDUN		;NOT IN RANGE, DONE
	IMUL	B,A		;NUM=NUM*10+NEWDIG
;; #QI# THESE THREE USED TO BE DOWN AT CVDUN
	JOV	[CAIN	A,10	;CVO?
		 TLC	B,400000 ;YES, THIS SPECIAL HACK ALLOWS TYPING AN
		 JRST	.+1]	;UNSIGNED OCTAL NO. WITH BIT 0 ON
;; #QI#
	ADDI	B,-"0"(X)
	SOJL	C,CVDUN		;DONE WHEN NEGATIVE
	ILDB	X,D
	JRST	CNV

CVDUN:
	IOR	Y,[MOVEM B,RACS+1(USER)] ;MOVEM OR MOVNM
	XCT	Y
	SUB	SP,X22
	JRST	RESTR

ENDCOM(CVD)
COMPIL(CVS,<GETFORMAT,SETFORMAT,CVS,CVOS>
	,<GOGTAB,INSET,X33,SAVE,RESTR,X11,X22,STRNGC>
	,<GETFORMAT, SETFORMAT, CVS, CVOS ROUTINES>)

DSCR "STR"_CVS(INTEGER);
CAL SAIL


HERE(CVS)	PUSHJ	P,SAVE
	PUSHJ	P,CVSET		;SET UP FOR CONVERSION
	MOVEI	D,=10		;WILL DIVIDE DECIMAL
	SKIPL	B,-2(P)		;IF NUMBER IS NEGATIVE,
	 JRST	 FRNP		; PRINT A MINUS SIGN,
	MOVM	B,B		;PRINT ABS VALUE
	JFCL	10,.+1		;
	MOVEI	Y,"-"		;Y IS NOT ZERO, SIGNALS BLKIN BELOW
	MOVEI	A,1		;ACCOUNT FOR EXTRA CHARACTER
;; #PG# (1 OF 2) MAKE CVS WORK FOR '400000000000
	JUMPGE	B,FRNP		;GO PRINT
; ACCOUNT FOR  LARGEST NEGATIVE NUMBER ('400000,0)
	MOVE	B,[=3435973836] ;34359738368 IS LARGEST NUMBER REP IN MACHINE
	MOVEI	C,"8"
	HRLM	C,(P)		;PUT ON STACK
	AOJA	A,FRNP1		;ACCOUNT FOR CHARACTER
;; #PG#

DSCR "STR"_CVOS(INTEGER);
CAL SAIL


HERE (CVOS)	PUSHJ	P,SAVE
	PUSHJ	P,CVSET
	MOVEI	D,10		;OCTAL DIVIDE
	MOVE	B,-2(P)		;GET THE DATA
	LSHC	B,-3		;MAKE SURE NUMBER BEING
	LDB	C,[POINT 3,C,2]	;DIVIDED IS + BY SIMULATING
	JRST	FRNX		; THE FIRST RESULT.

FRNP:	IDIV	B,D		;FAMOUS RECURSIVE NUMBER PRINTER
FRNX:	IORI	C,"0"
	HRLM	C,(P)
	ADDI	A,1
	JUMPE	B,BLKIN		;GO TEST FOR LEADING BLANKS
;; #PG# ! LABEL OTHER ENTRY POINT

FRNP1:	PUSHJ	P,FRNP
POPOFF:	HLRZ	C,(P)
	IDPB	C,TOPBYTE(USER)
	POPJ	P,

BLKIN:	MOVEI	D," "		;GIVE LEADING BLANKS IF WDTH POS,
	SKIPL	WDTH(USER)	; LEADING 0'S IF NEG.
	 JRST	 LEDBLK		;BLANKS
	MOVEI	D,"0"
	JUMPE	Y,LEDBLK	;NEGATIVE?
	IDPB	Y,TOPBYTE(USER)	;YES, PUT IN SIGN
	MOVEI	Y,0		;DON'T DO IT AGAIN!
LEDBLK:	CAML	A,X		;NEED MORE FILL?
	 JRST	 POPOF1		; NO
	IDPB	D,TOPBYTE(USER)	; YES, DROP IN ONE MORE
	AOJA	A,LEDBLK	;AND CONTINUE
POPOF1:	JUMPE	Y,POPOFF	;NEGATIVE, WERE FILLING BLANKS
	IDPB	Y,TOPBYTE(USER)	; YES, PUT SIGN IN AFTER BLANKS
	JRST	POPOFF		;GO PUT OUT NUMBER


FRNPDN:	HRROM	A,-1(SP)	;CHAR COUNT, NON-CONST STRING
	MOVEI	TEMP,=15	;GIVE BACK WHAT WASN'T USED
	CAMGE	TEMP,X		; (15 IF GT WDTH, ELSE WDTH
	MOVE	TEMP,X		;    USED FOR CALCULATION)
	SUB	A,TEMP
	ADDM	A,REMCHR(USER)	;UPDATE REMCHR
	JRST	RESTR


CVSET:
	SKIPE	SGLIGN(USER)	;IF ALIGNING,
	 PUSHJ	 P,INSET	; ALIGN
	MOVE	LPSA,X22
	MOVM	X,WDTH(USER)	;TOTAL FIELD SIZE, UNLESS NUMBER IS BIGGER
	MOVEI	A,=15		;CHECK THAT THERE WILL
	CAMGE	A,X		; BE ROOM FOR THE NUMBER
	MOVE	A,X		; (USE 15 OR WDTH, WHICHEVER IS BIGGER
	ADDM	A,REMCHR(USER)	
	SKIPLE	REMCHR(USER)
	PUSHJ	P,STRNGC	;NO ROOM
	MOVEI	A,0
	MOVEI	Y,0		;NOT NEG AS OF YET
	PUSH	SP,A		;A IS COUNT, SAVE STRING NO WORD SPACE
	PUSH	SP,TOPBYTE(USER);AND RESULTANT BYTE POINTER
	POP	P,D		;RETURN ADDR
	PUSH	P,[FRNPDN]	;CALLED IN-LINE FIRST TIME
	JRST	(D)



HERE (SETFORMAT)
	MOVE	USER,GOGTAB
	POP	P,TEMP		;RETURN ADDRESS
	POP	P,DIGS(USER)	;#DIGS TO RIGHT OF .
	POP	P,WDTH(USER)	;TOTAL FIELD WIDTH
	JRST	(TEMP)

DSCR GETFORMAT(@WIDTH,@DIGS);
CAL SAIL


HERE(GETFORMAT)
	MOVE	USER,GOGTAB
	MOVEW	(<@-1(P)>,<DIGS(USER)>)
	MOVEW	(<@-2(P)>,<WDTH(USER)>) ;GIVE USER RESULTS
	SUB	P,X33
	JRST	@3(P)			;RETURN

ENDCOM(CVS)
COMPIL(SCC,<SCANC>,<GETBREAK,SETBREAK,RELBREAK,SCAN>,<SCANC ROUTINE>)

DSCR
	STRING PROCEDURE SCANC(STRING ARG,BRK,OMIT,MODE); BEGIN "SCANC"
	INTEGER TBL,BRCHAR;
	TBL_GETBREAK; SETBREAK(TBL,BRK,OMIT,MODE);
	RSLT_SCAN(ARG,TBL,BRCHAR);
	RELBREAK(TBL);
	RETURN(RSLT) END "SCANC";


HEREFK(SCANC,SCANC.)
	PUSHJ	P,GETBREAK;
	PUSH	P,A		;SAVE TABLE NUMBER
	PUSH	P,A		;TABLE
	PUSHJ	P,SETBREAK	;GOBBLE DOWN ALL STRINGS BUT ARG
	PUSH	P,[0]		;SPACE FOR BRCHAR;
	MOVEI	A,(SP)
	PUSH	P,A		;LOC(ARG)
	PUSH	P,-2(P)		;TABLE #
	MOVEI	A,-2(P)		;LOC(BRCHAR)
	PUSH	P,A
	PUSHJ	P,SCAN
	POP	SP,-2(SP)	;CLOBBER ARG WITH RSLT
	POP	SP,-2(SP)
	POP	P,(P)		;REMOVE BREAK CHARACTER
	PUSHJ	P,RELBREAK	;GOBBLE SAVED TABLE NUMBER
	POPJ	P,
ENDCOM(SCC)

COMPIL(SCN,<SCAN,BKTCHK>
,<INSET,SAVE,RESTR,X44,STRNGC,BRKMSK,CORGET>
,<SCAN ROUTINE>)
DSCR "STR"_SCAN(@"STRING",BRKTBL,@BRCHAR);
CAL SAIL


HERE (SCAN)
..SCAN:	PUSHJ	P,SAVE
	SKIPE	SGLIGN(USER)
	PUSHJ	P,INSET
	MOVE	LPSA,X44
	SOS	C,-3(P)		;PTR TO STRING TO BE SCANNED
	HRRZ	A,(C)		;#CHARS IN INPUT STRING
;;%BK%	USED TO DO GC CHECKING HERE (NOW DO IT LATER)
	JUMPE	A,NULSCN	;IF NO CHARS TO SCAN
	MOVE	B,1(C)		;INPUT BYTE POINTER
	MOVEI	Z,0
	MOVE	X,-2(P)		;TABLE #
	MOVEI	TEMP,-1		;ERROR IF BLOCK NOT THERE OR NOT INIT'ED
	PUSHJ	P,BKTCHK	;CHECK OUT TABLE #
	 JRST	ENDSCN		;ERROR OF SOME SORT
				;CHNL IS NOW 1 TO 18, CDB POINTS AT CORGET BLOCK

SCNNX:	MOVE	D,BRKMSK(CHNL)	;HAS BITS ON FOR THIS TABLE
	TRNE	D,@BRKCVT(CDB)	;WANT CONVERSION?
;;%##% LDE 3-JAN-73	LET US ALLOW LOWER TO UPPER CASE CONVERSION
	TLOA	C,400000	; YES
	TLZ	C,400000	; NO
	SETZM	@-1(P)		;BREAK CHAR WORD
	MOVE	Y,CDB
	ADD	Y,[XWD	X,BRKTBL];RLC+BRKTBL(CDB)
	ADD	CHNL,CDB	;RELOCATE 1 TO 18
;;%BK%	SEE IF WE MUST COPY
	TRNN	D,@BRKOMT(CDB)	;COPY IF OMIT CHARS
	JUMPGE	C,NOCPY		;OR IF DOING CONVERSION

	ADDM	A,REMCHR(USER)	;WE MUST COPY THE STRING
	SKIPLE	REMCHR(USER)	;THE "OUT OF SPACE DANCE"
	PUSHJ	P,STRNGC
	PUSH	SP,A
	PUSH	SP,TOPBYTE(USER) ;RESULT BYTE POINTER
;;%SW% ! the garbage collector may get in
	MOVE	B,1(C)		;GET BYTE POINTER BACK

SCNLUP:	SOJL	A,SCNDUN	;STRING EXHAUSTED
	ILDB	X,B		;GET A CHAR
;;%##% UC CONVERSION
	JUMPGE	C,NOCNVS	;ONLY CONVERT IF WANTED
	CAIL	X,"a"
	CAILE	X,"z"
	JRST	.+2
	TRZ	X,40		;MAKE IT UPPER CASE
NOCNVS:	TDNE	D,@Y		;TDNE D,BRKTBL+RLC(X)
	 JRST	 SCNSPC		;OMIT OR BREAK
	IDPB	X,TOPBYTE(USER)
	AOJA	Z,SCNLUP

SCNSPC:	HLLZ	TEMP,@Y		;NOW SEE IF WE 
	TDNN	TEMP,D		;OMIT OR BREAK
	 JRST	 SCNLUP		; OMIT

SCNBRK:	MOVEM	X,@-1(P)	;SET BREAK CHAR WORD

SCNDUN:	SKIPN	TEMP,DSPTBL(CHNL) ;WHAT DO WE DO WITH BRCHAR?
	 JRST	 ENDSCN		; NOTHING
	JUMPL	TEMP,SCNAPN	;APPEND TO END OF STRING

SCNRET:	SOS	B		;LEAVE FOR NEXT TIME
	REPEAT	4,<IBP B
>
	JUMPL	A,ENDSCN	;STRING WAS EXHAUSTED
	AOJA	A,ENDSCN	;PUT ONE BACK

SCNAPN:
;;#FM# 11-15-71 DCS (1-1)
	JUMPL	A,ENDSCN	;SCANNED OFF END, NOTHING LEFT TO APPEND
;;#FM#
	IDPB	X,TOPBYTE(USER)
	ADDI	Z,1

;;#GI# DCS 2-5-72 REMOVE TOPSTR
ENDSCN:	MOVE	TEMP,Z		;#CHARS IN NEW STRING
	SUB	TEMP,-1(SP)	;NUMBER RESERVED BUT NOT USED
	ADDM	TEMP,REMCHR(USER);UNRESERVE THEM
	HRROM	Z,-1(SP)	;NOT A CONSTANT, NEW STRING SIZE
	JUMPGE	A,.+2		;IF EXHAUSTED, USE 0
	MOVEI	A,0
	HRRM	A,(C)		;UPDATE OLD COUNT
;;#GI#
	MOVEM	B,1(C)		;UPDATED ORIGINAL BYTE POINTER
	JRST	RESTR		;POPJ	P,

NULSCN:	SETZM	@-1(P)		;NO BREAKS
;;%BK%
	PUSH	SP,A		;NULL STRING RESULT
	PUSH	SP,A		;
	JRST	RESTR

NOCPY:	PUSH	SP,(C)		;COPY COUNT WRD FROM INPUT (WILL MUNCH)
	PUSH	SP,1(C)		;BYTE POINTER TO START
;;#TF# (=D4=) LDE ! IF NO BREAK CHAR, DON'T HANDLE ONE
SCNLP2:	SOJL	A,ENDSC2	;COUNT DOWN
	ILDB	X,B		;GET NEXT CHAR
	TDNN	D,@Y		;IS BREAK CHAR ON (KNOW NOT OMIT)
	AOJA	Z,SCNLP2	;JUST REGULAR
	MOVEM	X,@-1(P)	;IT WAS THE BREAK CHAR
SCNDN2:	SKIPN	TEMP,DSPTBL(CHNL) ; FIGURE OUT WHAT TO DO WITH BRK CHR
	JRST	ENDSC2		;NICHTS
	JUMPL	TEMP,SCNAP2	;APPEND IT
;	SOS	B		;BACK UP BYTE POINTER TO LEAVE CHAR
;	IBP	B		;
;;	IBP	B		;
;	IBP	B		;
;	IBP	B		;
;; JRL - FOLLOWING "OPTIMIZATION" FOR ABOVE CODE DUE TO REG
;;#TH# RHT 9-16-74 THE ADD & SUBTRACT CAN OVERFLOW
	ADD	B,[070000,,0]	;BACK UP BYTE POINTER
	JFCL	17,.+1		;SO OVERFL STAYS HAPPY
	JUMPG	B,.+3
	SUB	B,[430000,,1]	;BACK UP ONE WORD WHEN NECESSARY
	JFCL	17,.+1		;SO OVERFL STAYS HAPPY
;
	AOJA	A,ENDSC2	;& WE HAVE ONE MORE LEFT
SCNAP2:	ADDI	Z,1		;APPEND ONE MORE CHAR TO RESULT
ENDSC2:	HRRM	Z,-1(SP)	;
	CAIGE	A,0		;NEVER PUT NEG COUNT
	MOVEI	A,0		;THERE YOU GO
	HRRM	A,(C)		;FIX INPUT BYTE CNT
	MOVEM	B,1(C)		;NEW INPUT BYTE PTR
	JRST	RESTR		;ALL DONE
;;%BK%


DSCR BKTCHK
	Checks break table number for break table routines
	(SCAN,INPUT,TTYIN,PTYIN,BREAKSET,STDBRK)
CAL  PUSHJ P,BKTCHK
PAR	USER set up
	X    break table number
	TEMP flags
	     left half: what to do if CORGET block is not there
		0error, -1get a block
	     right half: whether table must be initialized
		0no, -1yes
SID  uses X,Y,CDB,CHNL  (also B,C if it is necessary to call CORGET)
RET  +1	error of some sort
     +2 no error.  CDB points at the CORGET block
		   CHNL is the table number modulo 18 in the range 1 to 18


HERE(BKTCHK)
;;#%%# ! MAKE BREAKTABLE 0  A SPECIAL CASE  JFR 11-2-74
	JUMPE	X,.BKCKZ
	ADDI	X,=17		;TABLE # NOW IN RANGE 0 THROUGH 71
	SKIPN	BKTPRV(USER)	;PRIVILEGED?
	CAIL	X,=18		;LOWEST FOR ORDINARY USERS
	CAILE	X,=71		;MAX FOR EVERYBOCY
;;#TP# BETTER ERROR MESSAGE JFR 10-26-74
	 JRST	[MOVE	X,X
		ERR	<BKTCHK: Breaktable out of range: >,7
		JRST	CPOPJ]
	IDIVI	X,=18
	MOVEI	CHNL,1(Y)	;CHNL NOW IN RANGE 1 TO 18
	MOVE	Y,X		;SAVE FOR POSSIBLE ERROR MESSAGE
	ADD	X,USER		;RELOCATE GROUP NUMBER
	SKIPN	CDB,BKTPTR(X)	;POINTER TO COREGET BLOCK
	 JRST	.BKCKN		;BLOCK NOT THERE
	TRNN	TEMP,-1		;NEED INITIALIZATION?
	 JRST	CPOPJ1		;NO
	HRRZ	X,BKJFFO(CDB)	;INITIALIZATION BITS
	TDNN	X,BRKMSK(CHNL)	;WAS IT INIT'ED?
;;#TP# BETTER ERROR MESSAGE JFR 10-26-74
	 JRST	[.BKCKE: IMULI	Y,=18	;RECONSTUCT THE NUMBER SO WE CAN DISPLAY IT
			 ADD	Y,CHNL
			 SUBI	Y,=18
			 ERR	<BKTCHK: Uninitialized break table: >,7
			JRST	CPOPJ]
CPOPJ1:	AOS	(P)		;SUCCESS, SKIP RETURN
CPOPJ:	POPJ	P,

.BKCKN:	JUMPGE	TEMP,.BKCKE	;IF INIT REQ'D AND BLOCK NOT THERE, ERROR
	PUSH	P,CHNL		;SAVE 1 TO 18
	PUSH	P,X		;SAVE LOCATION FOR POINTER
	MOVEI	C,BRKDUM+1	;AMOUNT TO GET
	PUSHJ	P,CORGET
	 ERR	<BKTCHK: CORGET failed>
	MOVE	CDB,B		;ADDR OF BLOCK
	SETZM	(B)		;CLEAN IT OUT
	HRLI	B,(B)		;
	HRRI	B,1(B)
	BLT	B,BRKDUM(CDB)	;
	POP	P,X
	POP	P,CHNL
	MOVEM	CDB,BKTPTR(X)	;SAVE FOR FUTURE REFERENCE
	JRST	CPOPJ1		;SUCCESS

;;#%%# MAKE SPECIAL CASE FOR BREAKTABLE 0	JFR 11-2-74
.BKCKZ:	SETZ	CHNL,		;CHEAT ON "RANGE 1 TO 18"
	MOVEI	X,1(USER)
	SKIPN	CDB,BKTPTR(X)	;POINTER FOR CORGET BLOCK, TABLES 1 TO 18
	 JRST	.BKCKN+1	;CORGET BLOCK NOT THERE: FETCH, FIDO
	JRST	CPOPJ1		;SUCCESS

ENDCOM(SCN)
COMPIL(CVC,<CVSIX,CVASC,CVSTR,CVXSTR,CV6STR,CVASTR>,<SAVE,RESTR,X11,X22,INSET,STRNGC,FLSCAN>
	  ,<CVSIX, CVASC, CVSTR, CVXSTR, CV6STR -- CHARACTER CONVERSION ROUTINES>)

DSCR SIXBIT INTEGER_CVSIX("STRING");
CAL SAIL

;;#LA# THIS ROUTINE USED TO CALL FILNAM

HERE (CVSIX)
	MOVEI	A,0		;WILL DPB THE SIXBIT INTO HERE
	HRRZ	TEMP,-1(SP)	;BYTE COUNT
	JUMPE	TEMP,CVSXX	;NULL
	CAILE	TEMP,6		;ONLY USE FIRST SIX CHARS
	MOVEI	TEMP,6		;
	MOVE	LPSA,[POINT 6,A];
	PUSH	P,B		;NEEDED 1 MORE AC
	MOVE	B,(SP)		;BYTE POINTER
CVSXXL:	ILDB	USER,B		;THE CHARACTER
	TRZN	USER,100	;MOVE 100 BIT TO 40
	TRZA	USER,40		;
	TRO	USER,40		;
	IDPB	USER,LPSA	;PUT AWAY
	SOJG	TEMP,CVSXXL	;LOOP
	POP	P,B		;GET BACK THE EXTRA AC
CVSXX:	SUB	SP,X22		;EXIT
	POPJ	P,

DSCR ASCII INTEGER_CVASC("STRING");
CAL SAIL


HERE (CVASC)
	PUSHJ	P,SAVE
	POP	SP,X
	POP	SP,B
	HRRZS	B		;STRING  ARG
	MOVEI	C,5
	MOVE	D,[POINT 7,A]
	MOVEI	A,0

LUP:	SOJL	B,DUNN
	ILDB	Y,X
	IDPB	Y,D
	SOJG	C,LUP		;COLLECT CHARS IN A

DUNN:	MOVEM	A,RACS+1(USER)	;RESULT
	MOVE	LPSA,X11
	JRST	RESTR

DSCR "STR"_CVSTR(ASCII INTEGER);
CAL SAIL


HERE (CVSTR)
	PUSHJ	P,SAVE
	MOVEI	A,5
	ADDM	A,REMCHR(USER)
	SKIPLE	REMCHR(USER)
	PUSHJ	P,STRNGC
	PUSHJ	P,INSET		;ALIGN TO FW BDRY
;;#GI# DCS 2-5-72 REMOVE TOPSTR
	PUSH	SP,[XWD 40,5]	;BEST NON-CONSTANT STRING REP
;;#GI#
	PUSH	SP,TOPBYTE(USER)
;; \UR#9\ MAKE SURE BIT 35 OFF (JRL)
;	MOVEW	@TOPBYTE(USER),-1(P)
;;; bit 35 sometimes left on. screws string compare in compiler
        move    14,-1(p)
        trz     14,1
        movem   14,@topbyte(user);
;;;
;; \UR#9\
	AOS	TOPBYTE(USER)
	MOVE	LPSA,X22
	JRST	RESTR

DSCR "STR"_CVXSTR(SIXBIT INTEGER);
CAL SAIL


HERE (CVXSTR)
	PUSHJ	P,SAVE
;;%BW% !
	MOVEI	C,0			;A FLAG
CVXST1:	SKIPE	SGLIGN(USER)
	PUSHJ	P,INSET
	MOVEI	A,6
	ADDM	A,REMCHR(USER)		;UPDATE REMAINING CHAR COUNT
	SKIPLE	REMCHR(USER)		;IS THERE ROOM FOR THIS STRING?
	 PUSHJ	 P,STRNGC		;NO, TRY TO GET IT
;;#GI# DCS 2-5-72 REMOVE TOPSTR
	PUSH	SP,[XWD 40,6]		;NON-CONST,,COUNT FOR RESULT
;;#GI#
	PUSH	SP,TOPBYTE(USER)	;RESULT STARTS HERE
	MOVEI	A,6
	MOVE	B,[POINT 6,-1(P)]	;POINT AT INPUT SIXBIT
	
;;%BW% MAKE THIS CODE WORK FOR CV6STR TOO
CVXLP:	ILDB	TEMP,B			;GET A SIXBIT CHAR
	JUMPE	C,CVXST2
	JUMPE	TEMP,CVXST3
CVXST2:	ADDI	TEMP,40			;CONVERT TO ASCII
	IDPB	TEMP,TOPBYTE(USER)	;PUT IN RESULT STRING, UPDATE TOPBYTE
	SOJG	A,CVXLP			;DO IT ALL
CVXST3:	MOVN	A,A			;MAKE REMCHR HONEST
	ADDM	A,-1(SP)		;AS WELL AS BYTE CNT IN STRING
	ADDM	A,REMCHR(USER)
	
	MOVE	LPSA,X22		;REMOVE ARG, RETURN ADDRESS
	JRST	RESTR			;AND RETURN

DSCR "STR"_CV6STR(SIXBIT INTEGER);
CAL SAIL
DES LIKE CVXSTR BUT STOPS ON SPACE.


HEREFK(CV6STR,CV6ST.)
	PUSHJ	P,SAVE
	MOVEI	C,1
	JRST	CVXST1
;;%BW% ^

;;%CA% 
DSCR "STR"_CVASTR(INTEGER)
CAL SAIL
DES LIKE CVSTR BUT STOPS ON A NULL CHARACTER


HEREFK(CVASTR,CVAST.)
	PUSHJ	P,SAVE
	MOVEI	A,5			;BE SURE HAVE ENOUGH ROOM
	ADDM	A,REMCHR(USER)
	SKIPLE	REMCHR(USER)
	PUSHJ	P,STRNGC
	PUSH	SP,[XWD 40,5]		;STERILE STRING CNT WD
	PUSH	SP,TOPBYTE(USER)	;WHAT THE DESCR WILL BE
	MOVE	4,-1(P);		;
	MOVEI	5,0			;
	MOVNI	A,5			;
	MOVE	TEMP,[POINT 7,4]	;
CVALP:	ILDB	C,TEMP			;PICK UP A CHARACTER
	JUMPE	C,CVALDN		;DONE WHEN SEE NULL
	IDPB	C,TOPBYTE(USER)		;PUT IT DOWN
	AOJA	A,CVALP	
CVALDN:					;CORRECT REMCHR
	ADDM	A,REMCHR(USER)
	ADDM	A,-1(SP)		;AND STRING DESCR
	MOVE	LPSA,X22		;RETURN
	JRST	RESTR

;; %CA% ^

ENDCOM(CVC)
COMPIL(CVL,<CVFIL>,<SAVE,RESTR,X22,X33,FILNAM,.SKIP.>,<CVFIL>)

DSCR SIXBIT INTEGER_CVFIL("FILE STRING",@RESULT EXTENSION,@RESULT PPN);
CAL SAIL


HERE (CVFIL)
	PUSHJ	P,SAVE
	SETZM	.SKIP.		;ASSUME NO PROBLEMS
	PUSHJ	P,FILNAM	;GET FILENAME COMPONENTS FROM STRING ARG
	SETOM	.SKIP.		;NO GOOD SPEC, REPORT IF HE'S INTERESTED
	MOVE	TEMP,FNAME(USER)
	MOVEM	TEMP,RACS+1(USER)	;AMJOR RESULT (NAME) TO R1
	MOVE	TEMP,FNAME+1(USER)
	MOVEM	TEMP,@-2(P)		;EXTENSION TO REF ARG.
	MOVE	TEMP,FNAME+3(USER)
	MOVEM	TEMP,@-1(P)		;PPN TO REF ARG.
;;=I09=	IF SFD POINTER, SET .SKIP. = 1, FOR OLD PROGRAMS
SFDS<
	SKIPE	.SKIP.		;IF REAL ERROR, DON'T DO THIS
	JRST	.+4
	JUMPE	TEMP,.+3
	TLNN	TEMP,777777	;IF NOT REAL PPN
	AOS	.SKIP.		;SET .SKIP. = 1
> ;SFDS
	MOVE	LPSA,X33
	JRST	RESTR
ENDCOM(CVL)
COMPIL(BRK,<BREAKSET,SETBREAK>
 ,<SAVE,RESTR,BRKMSK,BKTCHK,X22,X33>
	  ,<BREAKSET, SETBREAK ROUTINES>)
DSCR BREAKSET(TABLE #,"STRING",WAY);
CAL SAIL



HERE(BREAKSET)

	PUSHJ	P,SAVE		;SAVE ACS AND THINGS
	MOVE	LPSA,X33
	SUB	SP,X22
	MOVE	X,-2(P)		;TABLE #
	MOVSI	TEMP,-1		;GET BLOCK IF NOT THERE, NO NEED TO INIT
	PUSHJ	P,BKTCHK	;CHECK OUT TABLE #
	 JRST	RESTR		;ERROR RETURN
	MOVE	B,BRKMSK(CHNL)	;BITS FOR THIS TABLE
	IORM	B,BKJFFO(CDB)	;MARK THIS TABLE RESERVED & INIT'ED
	HLLZS	B		;LEFT HALF ONLY
	ADD	CHNL,CDB	;RELOCATE RANGE 1-18
	MOVE	C,[ANDCAM B,(D)]  ;USUAL CLEARING INSTR
	LDB	X,[POINT 4,-1(P),35] ;COMMAND
	TRZN	X,10		  ;LEFT OR RIGHT HALF OF TABLE?
	SKIPA	X,BKCOM(X)	  ;RIGHT HALF
	HLRZ	X,BKCOM(X)	  ;LEFT HALF
	JRST	(X)		  ;DISPATCH

BKCOM:	XWD	XCLUDE,PASLINS	;X,,P
	XWD	INCL,PENDCH	;I,,A
;;%DQ% ! JFR 8-17-76 to let INPUT handle NULs 
	XWD	ZSET,RETCH	;Z,,R
;;%##% ADD BREAK MODE FOR COERCIONS
	XWD	UCASE,SKIPCH	;K,,S
	XWD	BRKLIN,RESTR	;L,,D
	XWD	ILLSET,ERMAN	;-,,E
;;%BG% ! ADD WAY TO UNDO "K"
	XWD	NOLINS,LCASE	;N,,F
	XWD	OMIT,ILLSET	;O,,-

ILLSET:	ERR	<ILLEGAL COMMAND TO BREAKSET>,1
	JRST	RESTR

;;%BK% OMISION NOW MUST SET ANOTHER FLAG, TOO
;;XCLUDE: SKIPA	C,[IORM B,(D)]	;YES, SET ALL TO 1 TO INITIALIZE
;;OMIT:	MOVSS	B		;OMIT, PUT BIT IN RH

XCLUDE:	MOVE	C,[IORM B,(D)]	;EXCLUSION MEANS YOU FIRST SET TO ONE
	JRST	INCL		;GO DO IT

OMIT:	MOVSS	B		;OMIT HAS BIT IN RH
	HRRZ	A,1(SP)		;SET BIT ONLY IF HAVE SOME OMIT CHARS
	IORM	B,BRKOMT(CDB)	;ASSUME HAVE SOME
	CAIN	A,0		;HAVE ANY
	ANDCAM	B,BRKOMT(CDB)	;NO
;;%BK%
INCL:	MOVSI	D,-200
	HRRI	D,BRKTBL(CDB)	;RELOCATABLE IOWD
BRKLUP:	XCT	C		;CLEAR (OR SET) PROPER (HALF OF PROPER) TABLE
	AOBJN	D,BRKLUP

	MOVE	C,[IORM B,BRKTBL(D)]	;USUAL SETTING INSTR
	CAIN	X,XCLUDE	;BY EXCEPTION?
	MOVE	C,[ANDCAM B,BRKTBL(D)] ;YES, WANT TO TURN OFF BITS
	ADDI	C,(CDB)		;RELOCATE IT
	HRRZ	A,1(SP)		;LENGTH OF STRING
	MOVE	X,2(SP)		;BYTE POINTER
	JRST	BRKL2
BRKL1:	ILDB	D,X		;GET A CHAR
	XCT	C		;DO RIGHT THING TO RIGHT BIT
BRKL2:	SOJGE	A,BRKL1
;;%DQ% JFR 8-17-76 IF "I" OR "X" THEN CLEAR "Z"
	HLRZ	B,B		;B= IF "O" THEN 0 ELSE BIT
	ANDCAM	B,BRKDUM(CDB)	;CLEAR "Z"
;;%DQ% ^
	JRST	RESTR

PASLINS: TDZA	B,B		;PASS LINE NOS. SINE COMMENT
NOLINS:	MOVEI	B,-1		;INFORM IN THAT IT SHOULD 
	MOVEM	B,LINTBL(CHNL)	;  DELETE LINE NOS.
	JRST	RESTR

BRKLIN:	SKIPA	B,[-1]		;MARK BREAK ON LINE NOS. FOR THIS TBL
ERMAN:	MOVSI	B,-1		;LH NEG SIGNALS ERMAN'S SCHEME
	MOVEM	B,LINTBL(CHNL)
	JRST	RESTR

PENDCH:	SETOM	DSPTBL(CHNL)	;APPEND TO END OF INPUT
	JRST	RESTR

SKIPCH:	TDZA	B,B		;CHAR NEVER APPEARS IN INPUT STRING
RETCH:	MOVEI	B,-1		;RETAIN FOR NEXT TIME
	MOVEM	B,DSPTBL(CHNL)
	JRST	RESTR

;;%##%
UCASE:	MOVSS	B	;INTO RIGHT HLF
	IORM	B,BRKCVT(CDB)
	JRST	RESTR

;;%BG% =A1=
LCASE:	MOVSS	B
	ANDCAM	B,BRKCVT(CDB)
	JRST	RESTR

;;%DQ%
ZSET:	MOVSS	B
	IORM	B,BRKDUM(CDB)
	JRST	RESTR
COMMENT Setbreak 

  TBL IS AS IN BREAKSET
  BRKSTRNG IS USED FOR ANY "I" OR "X" APPEARING IN MODESTRNG
  OMITSTRNG (IF NOT NULL) IS USED TO SET THE "OMIT" SIDE OF THE TABLE
  MODESTRNG CAN CONTAIN ANY OF THE VALID BREAKSET "MODE" CHARACTERS
     I,X,O,N,R,A,P, or S.
This function is not attainable by the user unless he declares it.


DSCR SETBREAK(TABLE,"BREAKSTRING","OMITSTRING",MODESTRING");
CAL SAIL

HERE (SETBREAK)

	HRRZ	TEMP,-3(SP)		;DO OMIT STRING, IF PRESENT
	JUMPE	TEMP,NO.O		;NULL STRING DOESN'T COUNT
	PUSH	P,-1(P)			;TABLE #
	PUSH	SP,-3(SP)		;OMIT CHARACTERS
	PUSH	SP,-3(SP)
	PUSH	P,["O"]			;OMIT!
	PUSHJ	P,BREAKSET		;DO THAT
NO.O:	HRRZS	-1(SP)			;COUNT OF # OF COMMANDS
BKSLUP:	SOSGE	-1(SP)		;DONE?
	 JRST	 BKSDUN			; YES
	PUSH	P,-1(P)			;TABLE #
	ILDB	TEMP,(SP)		;COMMAND
	PUSH	P,TEMP
	PUSH	SP,-5(SP)
	PUSH	SP,-5(SP)		;STRING TO USE IF NECESSARY
	PUSHJ	P,BREAKSET
	JRST	BKSLUP			;DO IT -- AGAIN

BKSDUN:	SUB	P,X22
	SUB	SP,[XWD 6,6]
	JRST	@2(P)
ENDCOM(BRK)
COMPIL(SBK,<STDBRK>,<.SKIP.,OPEN,LOOKUP,GOGTAB,BKTCHK,ARRYIN,RELEASE,X22>,<STDBRK>)

IFE ALWAYS,<
TENX<
EXTERNAL $OSTYP
> ;TENEX
> ;IFE ALWAYS

DSCR STDBRK(CHANNEL);
CAL SAIL

HERE(STDBRK)
	PUSH	P,-1(P)			;CHANNEL
	GSYSIN				;[clh] sysind _ 0 for tenex, 2 for 20
	PUSH	SP,STDBDV(SYSIND)	;[clh]	
	PUSH	SP,STDBDV+1(SYSIND)	;[clh]
	PUSH	P,[14]			;MODE 14
	PUSH	P,[2]			;INPUT BUFFERS
	PUSH	P,[0]			;OUTPUT BUFFERS
	PUSH	P,[0]			;COUNT
	PUSH	P,[0]			;BRCHAR
	PUSH	P,[.SKIP.]		;EOF
	SETOM	.SKIP.			;[clh] Return if errors
	PUSHJ	P,OPEN			;OPEN CHANNEL
	SKIPE	.SKIP.			;ERROR?
	  ERR	<Can't open STDBRK channel>,1,STDEXT
	PUSH	P,-1(P)
	GSYSIN				;[clh]
	PUSH	SP,STDBFL(SYSIND)	;[clh]
	PUSH	SP,STDBFL+1(SYSIND)	;[clh]
	PUSH	P,[.SKIP.]
	SETZM	.SKIP.
	PUSHJ	P,LOOKUP
	SKIPE	.SKIP.
	  ERR	<Can't lookup STDBRK file>,1,STDEXT
	PUSH	P,-1(P)			;CHANNEL
	MOVE	USER,GOGTAB
	MOVEI	X,1		;ORDINARY USER TABLE #
	SKIPE	BKTPRV(USER)	;PRIVILEGED?
	 MOVEI	X,0		;YES
	MOVSI	TEMP,-1		;GET BLOCK IF NOT THERE, NO NEED TO INIT
	PUSHJ	P,BKTCHK	;CHECK OUT SITUATION
	 JRST	STDEXT		;ERROR OF SOME SORE
;;%DQ% !
	SETZM	BRKDUM(CDB)	;STANDARD TABLES HAVE NO "Z" MODES
	PUSH	P,CDB		;WHERE TO PUT IT
	PUSH	P,[BRKDUM]	;HOW MUCH TO READ
	PUSHJ	P,ARRYIN		;READ IN ARRAY
	PUSH	P,-1(P)			;CHANNEL
	PUSH	P,[0]			;CLOSE INHIBIT
	PUSHJ	P,RELEASE		;RELEASE THE FILE
STDEXT:
	SUB	P,X22			;CLEAR STACK
	JRST	@2(P)

STDBFL:
	BKTFIL
STDBDV: BKTDEV 				;[clh]

ENDCOM(SBK)


COMPIL(ABK,<GETBREAK,RELBREAK>,<SAVE,RESTR,BKTCHK,BRKMSK,CORREL,X11,X22>
,<BREAK TABLE ALLOCATION>)
DSCR GETBREAK
    returns the number of a free break table
CAL  SAIL

HERE (GETBREAK)
	PUSHJ	P,SAVE
	SKIPN	BKTPRV(USER)		;PRIVILEGED?
	 JRST	GTBK03			;NO
	MOVSI	D,-4			;YES, SEARCH ALL 4 GROPS
	HRRI	D,BKTPTR(USER)		;START AT FIRST GROUP
	SETZ	A,			;INITIALIZE RESULT
	JRST	GTBK04
GTBK03:	MOVSI	D,-3			;ORDINARY USER, SEARCH LAST 3
	HRRI	D,BKTPTR+1(USER)
	MOVEI	A,=18			;INITIALIZE RESULT
GTBK04:
	SETZ	C,			;INITIAL RESULT
;;#TP# ! TYPO--USED TO BE SKIPE  JFR 10-26-74
GTBK02:	SKIPN	CDB,(D)			;POINTER TO GROUP OF 18 TABLES
	 JRST	GTBK18			;NO POINTER, SO WHOLE BLOCK OF 18 FREE
	SETCM	B,BKJFFO(CDB)		;GET RESERVATION WORD
	JUMPE	B,GTBK01		;JUMP IF ALL 18 ARE RESERVED AND INIT'ED
	JFFO	B,.+1			;FIND FIRST UNRESERVED TABLE
	CAILE	C,=17			;CHECK ONLY RESERVATIONS, NOT INIT'S
	 JRST	GTBK01			;ALL 18 RESERVED
	ADD	A,C			;FOUND ONE
	ADDI	C,1
;;#TP# ! USED TO BE  MOVE  JFR 10-26-74
GTBKRT:	HLLZ	B,BRKMSK(C)		;RESERVE THIS TABLE
	IORM	B,BKJFFO(CDB)
;;#TP# IMPROVE REENTERABILITY
	MOVSS	B			;BIT INTO RIGHT HALF
	ANDCAM	B,BKJFFO(CDB)		;NOT INIT'ED
	ANDCAM	B,BRKCVT(CDB)
	ANDCAM	B,BRKOMT(CDB)
;;%DQ% !
	ANDCAM	B,BRKDUM(CDB)
	ADDI	C,(CDB)			;RELOCATE 1 TO 18
	SETZM	LINTBL(C)
	SETZM	DSPTBL(C)
;;#UO# =E7= JFR 7-28-75 explicitly zero the bits for each character
	MOVEI	CDB,BRKTBL(CDB)		;FWA OF CHAR TAB
	HRLI	CDB,-200		;AOBJN COUNT
	HRLI	B,(B)			;BIT IN EACH HALF
	ANDCAM	B,(CDB)			;ZAP!
	AOBJN	CDB,.-1
;;#UO# ^
GTBKF2:	SUBI	A,=17			;ADJUST FOR INITIAL OFFSET
	MOVEM	A,RACS+A(USER)		;RESULT
	MOVE	LPSA,X11
	JRST	RESTR			;DONE

GTBK01:	ADDI	A,=18
	AOBJN	D,GTBK02		;TRY NEXT GROUP OF 18
GTBKF:	MOVNI	A,1			;FAILURE
	JRST	GTBKF2
;;#TP# REVISED TO USE  BKTCHK  JFR 10-26-74
;;#%%# BUG FIX JFR 11-13-74
GTBK18:	MOVE	X,A			;TABLE NUMBER
	SUBI	X,=17			;CORRECT
	MOVSI	TEMP,-1			;CALL CORGET, NO INIT CHECK
	PUSHJ	P,BKTCHK
	 JRST	GTBKF			;ERROR RETURN
	MOVE	C,CHNL
	JRST	GTBKRT

DSCR RELBREAK
      release a break table
CAL SAIL


HERE (RELBREAK)
	PUSHJ	P,SAVE
RLBK01:	MOVE	X,-1(P)			;TABLE #
	ADDI	X,=17		;NEG TAB NUMS FOR PRIV USERS CAUSE PROBS
	SKIPN	BKTPRV(USER)	;PRIVILEGED?
	CAIL	X,=18		;LOWEST FOR ORDINARY USER
	CAILE	X,=71		;MAX FOR EVERYBODY
	 JRST	RLBKRT		;RELEASE ALWAYS WORKS
	IDIVI	X,=18
	MOVEI	A,1(Y)			;A NOW IN RANGE 1 TO 18
	ADD	X,USER			;RELOCATE GROUP NUMBER
	SKIPN	B,BKTPTR(X)		;B GETS POINTER TO CORRECT GROUP OF TABLES
	 JRST	RLBKRT			;NON-FATAL ERROR
	MOVE	TEMP,BRKMSK(A)		;BITS FOR THE TABLE
	ANDCAB	TEMP,BKJFFO(B)		;UNRESERVE
	JUMPN	TEMP,RLBKRT		;IF STILL SOME RESERVED
	SETZM	BKTPTR(X)		;THIS GROUP DEFUNCT
	PUSHJ	P,CORREL		;RELEASE BLOCK POINTED TO BY  B
RLBKRT:	MOVE	LPSA,X22	
	JRST	RESTR

ENDCOM(ABK)
COMPIL(PRN,<$PRINT,$$PRIN,SETPRINT,GETPRINT,$PINT,$PREL,$PITM,$PSET,$PLST,$PREC,$PSTR,$PLRL>
	,<GOGTAB,X22,OUT,OUTSTR,INCHWL,OPEN,GETCHAN,ENTER,.SKIP.,RELEASE,CAT,GETFOR,SETFOR,CATCHR,CVIS,X33,CVS,CVG,CVEL>
	,<STRING PRINTING ROUTINE>)
COMMENT $print

NOTTTY __ 400000		; WANT PRINT OUTPUT TO THE TELETYPE
WNTFLE __ 200000		; WANT PRINT OUTPUT TO A FILE
HAVFLE __ 100000		; HAVE A FILE FOR OUTPUT
WNTTTY __ 000000		; DONT WANT ANY OUTPUT AT ALL

;;%BF% GENERAL STRING OUTPUT ROUTINE

BEGIN STRPRN
;; CONTROL BITS:
UROUTB __ 400000		; IF ON THEN JRST (CTRL)
RTNSTR __ 200000		; IF ON THEN RETURN(S) ELSE RETURN (NULL)
TTYYES __ 100000		; IF ON THEN ALWAYS DO OUTSTR
TTYNOT __ 040000		; IF ON THEN DONT OUTSTR UNLESS TTYYES ON
CHNSPC __ 020000		; IF ON THEN RH(CTRL) IS CHANNEL (OR JFN)
CHNNOT __ 010000		; IF ON THEN DO NOT PUT OUT ANYTHING ON DEFAULT
				; CNANNEL

;ALSO THERE IS A WORD PRNINF(USER) THAT CONTAINS SOME "DEFAULTS"

DSCR STRING PROC $PRINT("S",CTRL(0))

DES	ROUTINE (ROUGHLY) IS:

	BEGIN
	I_PRNINF(USER);
	IF UROUTB LAND CTRL THEN JRST @RH(CTRL);
	IF UROUTB LAND I THEN JRST @RH(I);
$$PRIN: COMMENT THE ENTRY POINT AFTER TRAPPING OUT TO THE USER;
	IF (TTYYES LAND CTRL) THEN 
		OUTSTR(S)
	ELSE IF NOT (TTYNOT LAND CTRL) THEN
		BEGIN
		IF NOT ( (TTYYES!TTYNOT) LAND I) THEN
			<SET TTY DEFAULTS>;
		IF TTYYES LAND I THEN OUTSTR(S);
		END;
	IF CHNSPC LAND CTRL THEN OUTF(RH(CTRL),S);
	IF NOT (CHNNOT LAND CTRL) THEN
		BEGIN
		IF NOT ( (CHNNOT!CHNSPC) LAND I) THEN
			<SET OUTPUT CHANNEL DEFAULTS>;
		IF CHNSPC LAND I THEN OUTF(RH(I),S);
		END;
	IF RTNSTR LAND CTRL THEN RETURN(S) ELSE RETURN(NULL);
	END;


;; $PRINT ACTUAL CODE

HERE($$PRIN)
	TDZA	A,A
HERE($PRINT)
	MOVEI	A,1
	MOVE	C,-1(P)		;CONTROL BITS
	MOVE	USER,GOGTAB	;
	MOVE	B,PRNINF(USER)	;"DEFAULT" BITS
	JUMPE	A,SPRN.1	;CAME FROM STRPR1?
	TLNE	C,UROUTB	;USER ROUTINE?
	JRST	(C)		;YES
	TLNE	B,UROUTB	;USER SPEC ONE HERE?
	JRST	(B)		;YES

SPRN.1:			;STRPR1 COMES IN HERE
	TLNE	C,TTYYES	;DID HE DEMAND OUTSTR?
	JRST	.OSTRC		;YES
	TLNE	C,TTYNOT	;DID HE DEMAND NOT?
	JRST	SPRN.3		;YES
	TLNN	B,TTYNOT!TTYYES ;IS A DEFAULT ESTABLISHED?
	PUSHJ	P,PDFSET	;NO, DO SO
SPRN.2:	TLNN	B,TTYYES	;DOES HE WANT IT?
	JRST	SPRN.3		;NO
.OSTRC:	PUSH	SP,-1(SP)	;
	PUSH	SP,-1(SP)	;
	PUSHJ	P,OUTSTR	;OUTSTR(S);
SPRN.3:	TLNE	C,CHNSPC	;SPECIFIED CHANNEL?
	JSP	D,OUTFN		;OUT(SPEC CHAN,S);
	JUMP	(C)		;EFFECTIVE ADDRESS IS CHANNEL NO
SPRN.4:	TLNE	C,CHNNOT	;DID HE SAY THAT IS ALL?
	JRST	SPRN.5		;YES
	TLNN	B,CHNNOT!CHNSPC	;DEFAULTS SET YET?
	PUSHJ	P,PDFSET	;NOPE DO IT NOW
	TLNE	B,CHNSPC	;CHANNEL SPECIFIED NOW?
	JSP	D,OUTFN		;OUTPUT FUNCTION
	JUMP	(B)		;PASS CHANNEL NUMBER THIS WAY
SPRN.5:	TLNN	C,RTNSTR	;DID WE WANT S KEPT?
	SETZM	-1(SP)		;RETURN A NULL INSTEAD OF S
	SUB	P,X22		;RETURN
	JRST	@2(P)		;

OUTFN:	MOVEI	A,@(D)		;GET CHANNEL NUMBER
	PUSH	P,A		;PUSH IT
	PUSH	SP,-1(SP)	;
	PUSH	SP,-1(SP)	;COPY IS LIKELY FOOLISH
	PUSHJ	P,OUT		;
	JRST	1(D)		;RETURN --RELY ON OUT TO SAVE ACS

PDFSET:	PUUO	3,[ASCIZ/
$PRINT called without initialization.
Output to teletype?/]
	MOVSI	B,TTYYES!CHNNOT	;INITIALLY, ASSUME TTYON
	PUSHJ	P,$YN
	MOVSI	B,TTYNOT!CHNNOT	;NO WE DONT
	PUUO	3,[ASCIZ/Output to file?/];
	PUSHJ	P,$YN		;ASK ABOUT IT
	JRST	OPTSET		;NO
	TLC	B,CHNNOT!CHNSPC	;YES, WE WILL
DOOP:	PUSHJ	P,GETCHAN	;CHANNEL NUMBER
	HRR	B,A		;REMEMBER HERE,TOO
	PUSH	P,A		;CHANNEL NO
	PUSH	SP,[3]		;DSK
	PUSH	SP,[ POINT 7,[ASCIZ/DSK/]]
	PUSH	P,[0]		;MODE 0
	PUSH	P,[0]		;NO INPUT
	PUSH	P,[3]		;3 OUTPUT BUFFERS
	PUSH	P,[0]
	PUSH	P,[0]
	PUSH	P,[.SKIP.]	;EOF VAR 
	SETZM	.SKIP.
OPIT:	PUSHJ	P,OPEN		;OPEN THE CHANNEL
	SKIPE	.SKIP.
	ERR	<OPEN LOST>,1,DOOP

ENIT:	PUUO	3,[ASCIZ /File Id=/]
	PUSH	P,A
	PUSHJ	P,INCHWL
	PUSH	P,[.SKIP.]
	PUSHJ	P,ENTER
	SKIPE	.SKIP.
	JRST	ENIT
OPTSET:	MOVEM	B,PRNINF(USER)
	POPJ	P,

$YN:	PUSHJ	P,INCHWL
	HRRZ	FF,-1(SP);
	JUMPE	FF,YNRET;
	ILDB	FF,(SP)
	CAIE	FF,"Y"
	CAIN	FF,"y"
	AOS	(P)		;SKIP RET IF YES
YNRET:	SUB	SP,X22
	POPJ	P,

INTERNAL P.FIN

HERE(P.FIN)
	BEGIN 	P.FIN
	MOVE	USER,GOGTAB
	SKIPE	B,PRNINF(USER)			;FIRST CLOSE $PRINT FILE
	TLNE	B,UROUTB
	  JRST	CONTIN
	TLNN	B,CHNSPC
	  JRST	CONTIN
	HRRZS	B
	PUSH	P,B
	PUSH	P,[0]
	PUSHJ	P,RELEASE
CONTIN:	SKIPE	B,PRTINF(USER)			;NOW CLOSE PRINT FILE (WOW!)
	TLNN	B,HAVFLE
	  POPJ	P,
	HRRZS	B
	PUSH	P,B
	PUSH	P,[0]
	PUSHJ	P,RELEASE
	POPJ	P,

	BEND	P.FIN

BEND STRPRN
DSCR	PRINT routines
	The SETPRINT and GETPRINT change the output conditions for
the PRINT statement (not CPRINT).
	There are three things that may be happening:  the user
may or may not have a file open, if so it may or may not be
selected for output; and the user may want output to go to the
terminal.  This makes 6 possibilites.  Each is represented by
a letter that suggests the meaning.
	Bits indicating what is happening are stored in the
left half of user table entry PRTINF; the right half contains
the channel number.  Bits indicate if the teletype is NOT selected,
if a file is open, and if the file is selected.  These are, symbolically,
WNTTTY, HAVFLE, and WNTFLE.  Note that 0 for the entire word means
to just use the teletype for output.  This is because the user
table gets zeroed at the start, and so it is given the meaning
of the letter "T".


HEREFK(SETPRINT,SETPR.)
	BEGIN	SETPRINT

DEFINE TST(X,Y) <
	CAIN	D,"X"
	  MOVSI	B,Y
>;
	MOVE	USER,GOGTAB
	MOVE	TEMP,(P)
	MOVEM	TEMP,UUO1(USER)
	MOVE	D,-1(P)				;GET ARGUMENT
	CAIL	D,"a"
	CAILE	D,"z"
	  SKIPA
	  SUBI	D,40				;CONVERT TO UPPER CASE
	SETO	B,
	CAIN	D,"C"				;CONSOLE?
	  JRST	[MOVE	B,PRTINF(USER)
		TLZ	B,NOTTTY		;TURN ON TELETYPE
		 JRST	SETRET]
	CAIN	D,"I"				;IGNORE TERMINAL
	  JRST	[MOVE	B,PRTINF(USER)
		TLO	B,NOTTTY
		 JRST	SETRET]
	TST	T,WNTTTY
	TST	F,NOTTTY+WNTFLE+HAVFLE
	TST	B,WNTTTY+WNTFLE+HAVFLE
	TST	N,NOTTTY
	TST	S,NOTTTY+HAVFLE
	TST	O,WNTTTY+HAVFLE
	CAME	B,[-1]				;NOT LEGAL OPTION
	  JRST	OKSET
	PUUO	1,D				;PRINT A CHAR
	ERR	<
SETPRINT:  Above mode is not legal>,1
	MOVSI	B,WNTTTY			;FOR DEFAULT ASSUME TTY
	JRST	SETRET
OKSET:	
	MOVE	D,PRTINF(USER)			;GET OLD VALUE
	TLNE	D,HAVFLE			;IF HAVE A FILE
	TLNE	B,HAVFLE			;BUT DONT WANT IT
	  JRST	OKREL
	HRRZS	D
	PUSH	P,D
	PUSH	P,[0]				;CLOSE INHIBIT BITS
	PUSHJ	P,RELEASE			;RELEASE FILE
	JRST	SETRET				;AND RETURN
OKREL:
	TLNE	D,HAVFLE			;IF WE HAVE A FILE
	TLNN	B,HAVFLE			;AND WANT A FILE
	  JRST	CHKNEED				
	HRR	B,D				;THEN USE IT
	JRST	SETRET
CHKNEED:
	TLNN	B,HAVFLE			;WANT A FILE?
	  JRST	SETRET
NOTENX<
	HRRZ	A,-1(SP)
	JUMPG	A,.+2				;HAVE A FILE NAME?
	PUSHJ	P,GETNAME			;NEED A NAME
GETDSK:
	PUSHJ	P,GETCHAN			;GET A CHANNEL
	CAMN	A,[-1]
	  ERR	<SETPRINT:  GETCHAN failed>
	HRR	B,A				;PUT CHANNEL NUMBER IN RH(B)
	PUSH	P,A				;CHANNEL ARG
	PUSH	SP,[3]
	PUSH	SP,[POINT 7,[ASCIZ/DSK/],-1]
	PUSH	P,[0]				;MODE 0
	PUSH	P,[0]				;INPUT BUFFERS
	PUSH	P,[3]				;OUTPUT BUFFERS
	PUSH	P,[0]				;COUNT WORD
	PUSH	P,[0]				;BRCHAR
	SETZM	.SKIP.
	PUSH	P,[.SKIP.]			;END OF FILE
	PUSHJ	P,OPEN				;CALL FUNCTION
	SKIPE	.SKIP.				;A PROBLEM
	  ERR 	<SETPRINT:  OPEN to the DSK has failed>,1,GETDSK
DOENT:	PUSH	P,A				;CHANNEL
	PUSH	SP,-1(SP)
	PUSH	SP,-1(SP)			;FILE NAME
	PUSH	P,[.SKIP.]
	PUSHJ	P,ENTER
	SKIPE	.SKIP.
	  JRST	[PUUO 3,[ASCIZ/SETPRINT:  ENTER failed, type file name
/]
		 PUSHJ	P,GETNAME
		 JRST	DOENT]
	
	JRST	SETRET

GETNAME:
	PUUO	3,[ASCIZ/
File for PRINT output  */]
	PUSHJ	P,INCHWL
	POP	SP,-2(SP)
	POP	SP,-2(SP)
	POPJ	P,
>;NOTENX
TENX<
EXTERNAL OPENFILE
GETDSK:
	PUSH	P,B
	HRRZ	A,-1(SP)			;COUNT OF FILENAME
	JUMPG	A,.+2				;CHECK LENGTH
	PUUO	3,[ASCIZ/
File for PRINT output  */]
	PUSH	SP,-1(SP)
	PUSH	SP,-1(SP)			;FILE NAME
	PUSH	SP,[2]
	PUSH	SP,[POINT 7,[ASCIZ/WC/],-1]
	PUSHJ	P,OPENFILE
	POP	P,B
	HRR	B,A				;CHANNEL NUMBER
	JRST	SETRET
>;TENX

SETRET:	
	MOVEM	B,PRTINF(USER)
	SUB	SP,X22
	SUB	P,X22
	JRST	@2(P)				;RETURN
	BEND SETPRINT

HEREFK(GETPRINT,GETPR.)
	BEGIN 	GETPRINT
DEFINE TST(X,Y) <
	CAIN	TEMP,X
	  MOVEI	A,"Y"
>;
	MOVE	USER,GOGTAB
	MOVE	TEMP,(P)
	MOVEM	TEMP,UUO1(USER)
	HLRZ	TEMP,PRTINF(USER)
	SETO	A,
	TST	WNTTTY,T
	TST	NOTTTY+WNTFLE+HAVFLE,F
	TST	WNTFLE+WNTTTY+HAVFLE,B
	TST	NOTTTY,N
	TST	NOTTTY+HAVFLE,S
	TST	HAVFLE+WNTTTY,O
	CAMN	A,[-1]
	  ERR	<GETPRINT:  Illegal mode>,1
	POPJ	P,

	BEND 	GETPRINT
DSCR $PRSTR -- final string printer

PROCEDURE $PRSTR(STRING S)

Called for either PRINT or CPRINT.  Actually does the final output.

CAL	PUSHJ (EFFECTIVELY -- ACTUALLY JRST)
ARG	STRING ON SP STACK
	CHANNEL ON P STACK, -1 FOR TELETYPE
RET	THE STRING IS CLEARED FROM THE SP STACK, AND POPJ RETURN
SID	NOTHING IS SAFE IF USER ROUTINE CALLED




$PRSTR:	
	BEGIN $PRSTR

	MOVE	USER,GOGTAB
	SKIPE	TEMP,$$PROU(USER)
	  JRST	WNTOWN				;OWN OUTPUTTING FN.

PRINT1:	MOVE	TEMP,-1(P)			;GET CHANNEL NUMBER
	CAME	TEMP,[-1]			;IS IT -1?
	  JRST	WNTCHN				;NO, MUST BE A CHANNEL

	SKIPN	B,PRTINF(USER)			;SEE IF SETPRINT DONE
	  JRST	OUTSTR				;JUST DEFAULT SETPRINT, THAT'S ALL
	TLNE	B,NOTTTY			;TELETYPE WANTED?
	  JRST	NOTTY				;NO
	PUSH	SP,-1(SP)
	PUSH	SP,-1(SP)
	PUSHJ	P,OUTSTR
NOTTY:	TLNN	B,WNTFLE			;FILE WANTED?
	  JRST	[SUB	SP,X22
		 POPJ	P,]
	HRRZS	B
	PUSH	P,B
	JRST	WNTCH1

WNTCHN:	PUSH	P,TEMP				;THE CHANNEL NUMBER
WNTCH1:	PUSHJ	P,OUT				;STRING ON STACK
	POPJ	P,				;AND RETURN

WNTOWN:	PUSH	P,-1(P)				;PUSH CHANNEL NO.
	PUSHJ	P,(TEMP)			;CALL USER FUNCTION
	POPJ	P,


	BEND $PRSTR
DSCR
	These funtions are the top-level functions called from SAIL
for the PRINT and CPRINT statement, for argument types that
are passed on the P stack.  The other case, of course, is
a string value, which follows directly.
	The calls for the PRINT or CPRINT statement are generated 
by first pushing the channel number onto the P stack (-1 for Teletype),
then calling a special routine for each basic syntactic type
encountered.  After all calls for the syntactic types, the
channel is removed from the P stack, by a SUB P,[xwd 1,1] instruction
following the calls to the PRINT routines.

CAL	PRINT or CPRINT statements
ARG	standard SAIL argument passing
	CHANNEL is on the P stack, -1 if Teletype
	ARG	is on the P stack

SID	nothing saved
RES	nothing



DEFINE PMAK ! (X,X1,Y,Z) <
HEREFK(X,X1)
	MOVE	USER,GOGTAB
	MOVE	TEMP,(P)
	MOVEM	TEMP,UUO1(USER)
	PUSH	P,-1(P)			;PUSH THE ARGUMENT
	SKIPE	TEMP,Z(USER)		;USER FORMATTING FUNCTION
	   JRST	PRTOWN
	PUSHJ	P,Y			;NO, CALL STANDARD FORMATTING
	JRST	PRRET			
>;PMAK
					;FUNCTION
;CODE COMMON TO ALL PRINTING FUNCTIONS

PRTOWN:	PUSHJ	P,(TEMP)
PRRET:	POP	P,-1(P)			;SPLICE ARG OUT FROM STACK
	JRST	$PRSTR			;AND RETURN


PMAK	$PINT,$PINT.,CVS,$$FINT
PMAK	$PREL,$PREL.,CVG,$$FREL
PMAK	$PITM,$PITM.,PN,$$FITM
PMAK	$PSET,$PSET.,PSET1,$$FSET
PMAK	$PLST,$PLST.,PLST1,$$FLST
PMAK	$PREC,$PREC.,PREC,$$FREC
HEREFK($PLRL,$PLRL.)
	MOVE	USER,GOGTAB
	MOVE	TEMP,(P)
	MOVEM	TEMP,UUO1(USER)
	PUSH	P,-2(P)			;PUSH THE ARGUMENT
	PUSH	P,-2(P)
	SKIPN	TEMP,$$FLRL(USER)	;USER FORMATTING FUNCTION
	 MOVEI	TEMP,CVEL		;NONE, USE STANDARD
	PUSHJ	P,(TEMP)
	POP	P,-1(P)			;SPLICE OUT ARG
	POP	P,-1(P)
	JRST	$PSTR

HEREFK($PSTR,$PSTR.)
	MOVE	USER,GOGTAB
	MOVE	TEMP,(P)
	MOVEM	TEMP,UUO1(USER)
	SKIPE	TEMP,$$FSTR(USER)	;SPECIAL STRING FORMATTER?
	  PUSHJ	P,(TEMP)		;YES
	JRST	$PRSTR			;PRINT AND RETURN
DSCR	Utility routines for PRINT statement.


DSCR	PN

STRING PROCEDURE PN(ITEM X)

returns the PNAME of X if one exists, else ITEM!XXX, where XXX is the item number.
Special provision is made for the special items of the SAIL runtime system.



PN:	
	BEGIN PN
	PUSH	P,[0]			;USE STACK FOR VARIABLE
	MOVEI	A,(P)
	PUSH	P,-2(P)			;ARGUMENT X NOW
	PUSH	P,A			;ADDRESS OF FLAG
	PUSHJ	P,CVIS			;GET STRING ON STRING STACK	
	SKIPN	(P)			;FLAG OK?
	  JRST	RET			;YES OK
	SUB	SP,X22			;CLEAR OFF STACK
	MOVE	A,-2(P)			;GET ITEM NUMBER
	CAILE	A,3			;BIGGER THAN BUILTIN RANGE?
	  JRST	USENUM			;YES, USE THE NUMBER
	PUSH	SP,[36612](A)
	PUSH	SP,[440700,,STRN
		    170700,,STRN
		    100700,,STRN+1
		    440700,,STRN+3](A)
	JRST	RET
USENUM:	PUSH	SP,[5]
	PUSH	SP,[POINT 7,[ASCII/ITEM!/],-1]
	PUSH	P,-2(P)			;ARGUMENT AGAIN
	PUSH	P,[-4]			;FOR ACVS
	PUSHJ	P,ACVS			;GO OFF AND DO IT
	PUSHJ	P,CAT			;CONCATENATE
RET:	SUB	P,X33			;CLEAR OFF EVERYTHING
	JRST	@2(P)			;AND RETURN


STRN:	ASCII/ANYMAINPIBINDITEVENT!TYPE/
	BEND PN

DSCR ACVS
	
STRING PROCEDURE ACVS(INTEGER I,F)

Returns the CVS representation of I by first setting the format
control to F.  Used to ensure that there are no leading spaces etc.



ACVS:
	PUSH	P,[0]
	PUSH	P,[0]
	MOVEI	A,-1(P)
	PUSH	P,A
	MOVEI	A,-1(P)
	PUSH	P,A
	PUSHJ	P,GETFORMAT		;GET FORMAT INTO STACK LOCATIONS
	PUSH	P,-3(P)			;F ARGUMENT
	PUSH	P,[0]			;DOESNT MATTER
	PUSHJ	P,SETFORMAT
	PUSH	P,-4(P)			;I ARGUMENT
	PUSHJ	P,CVS			;GET STRING ONTO STRING STACK
	PUSHJ	P,SETFORMAT
	SUB	P,X33			;CLEAR OFF STACK
	JRST	@3(P)			;AND RETURN

DSCR GODOWN
	
STRING PROCEDURE GODOWN(LIST or SET S)

CDR's down S creating a string of the PN's of the items in S.
Does not copy structure etc.  Returns the string representing
this list, sans braces, which are added in the calling function.


GODOWN:	BEGIN GODOWN

	PUSH	SP,[0]
	PUSH	SP,[0]			;PREPARE FOR STRING
	MOVE	1,-1(P)
	HRRZ	1,(1)
LOOP:	JUMPE	1,DONE
	HLRZ	2,(1)			;J _ CAR(I)
	HRRZ	1,(1)			;I _ CDR(I)
	PUSH	P,1			;SAVE
	PUSH	P,2			;SAVE
	PUSH	P,2			;ARGUMENT
	PUSHJ	P,PN			;GET STRING
	PUSHJ	P,CAT			;HOOK ON STRING
	POP	P,2			;RESTORE
	POP	P,1
	JUMPE	1,DONE			
	PUSH	SP,[2]
	PUSH	SP,[POINT 7,[ASCIZ/, /],-1]
	PUSHJ	P,CAT
	JRST	LOOP

DONE:	SUB	P,X22
	JRST	@2(P)			;RETURN
	BEND GODOWN


DSCR	PSET1  -- default formatter for sets


PSET1:	BEGIN PSET1
	SKIPN	-1(P)			;EMPTY?
	  JRST	RETPHI			;YES
	PUSH	SP,[1]
	PUSH	SP,[POINT 7,[BYTE (7) 173,173],-1]
	PUSH	P,-1(P)
	PUSHJ	P,GODOWN
	PUSHJ	P,CAT
	PUSH	SP,[1]
STANFO <
	PUSH	SP,[POINT 7,[BYTE (7) 176,176],-1]
>
NOSTANFO <
	PUSH	SP,[POINT 7,[BYTE (7) 175,175,0,0,0],-1]
>
	PUSHJ	P,CAT	
RET:	SUB	P,X22
	JRST	@2(P)
	
RETPHI:	PUSH	SP,[3]
	PUSH	SP,[POINT 7,[ASCIZ/PHI/],-1]
	JRST	RET

	BEND PSET1


DSCR	PLST1  -- default formatter for lists

PLST1:	BEGIN PLST1
	SKIPN	-1(P)				;ANYTHING THERE?
	  JRST	RETNIL				;NO
	PUSH	SP,[2]
	PUSH	SP,[POINT 7,[BYTE (7) 173,173],-1]
	PUSH	P,-1(P)
	PUSHJ	P,GODOWN
	PUSHJ	P,CAT
	PUSH	SP,[2]
STANFO <
	PUSH	SP,[POINT 7,[BYTE (7) 176,176],-1]	;STANFORD CROCK "ASCII"
>
NOSTANFO <
	PUSH	SP,[POINT 7,[BYTE (7) 175,175,0,0,0],-1]
>
	PUSHJ	P,CAT
RET:	SUB	P,X22
	JRST	@2(P)
	
RETNIL:	PUSH	SP,[3]
	PUSH	SP,[POINT 7,[ASCIZ/NIL/],-1]
	JRST	RET

	BEND PLST1

DSCR	PREC -- default printer for record pointers

PREC:	BEGIN PREC

	MOVE	3,-1(P)			;RECORD
	JUMPE	3,NULLREC		;SPECIAL FOR NULL!RECORD
	MOVE	3,(3)			;POINTER TO CLASS
	MOVE	3,5(3)			;POINTER TO WD2 OF STRING
					;DESCR FOR CLASS NAME
	PUSH	SP,-1(3)
	PUSH	SP,(3)			;STRING TO STACK
	PUSH	P,["."]
	PUSHJ	P,CATCHR
	PUSH	P,-1(P)
	PUSH	P,[0]
	PUSHJ	P,ACVS
	PUSHJ	P,CAT

RECRET:	SUB	P,X22
	JRST	@2(P)
	

NULLREC:
	PUSH	SP,[=11]
	PUSH	SP,[POINT 7,[ASCIZ/NULL!RECORD/],-1]
	JRST	RECRET


	BEND PREC
ENDCOM(PRN)

IFE ALWAYS,<
COMPIL(DM5,<P.FIN>,,<DUMMY $PRINT FINISHER>)
^^P.FIN:
	POPJ	P,
ENDCOM(DM5)
>;IFE ALWAYS
COMPIL(DVF,<CVEL>,<GOGTAB,STRNGC,SAVE,RESTR>,<LONG REAL TO STRING CONVERSION>)
			;#ZF#	 ^        ^
;TITLE DOUBT.  V.030.0.140    DOUBLE PRECISION OUTPUT PDP-10
;SUBTTL	28-APR-71	/DMN
		;FROM	V.027U	9-NOV-70	/DMN
		;FROM	V.022- 1-DEC-69	/TWE
		;FROM V.020-APRIL 23,1969	/TWE
		;V.005  10-MAR-67

;	DOUBT. OUTPUTS ONE DOUBLE PRECISION WORD.  IT IS
;	CALLED BY 

;	PUSH	17,FMTWRD
;	MOVE	0,A
;	MOVE	1,A+1
;	PUSHJ	P,DOUBT.

;	WHERE A IS THE ADDRESS OF THE DOUBLE PRECISION WORD
;	AND FMTWRD IS A FORMAT WORD AS DESCRIBED IN FLOUT.

BEGIN CVEL
AC__0		;AC+1 IS ALSO USED
MUL__AC+1	;MUL+1 IS ALSO USED
BITS__3
IN__5
XP__4
D$__5
W__1
FR__10		;FR+1 IS ALSO USED
IGN__6	;*****
S__13
DIG__14
R__7	;*****
Q__7	;*****

NAC__15

MAXDIG__=18							; *EJG* 06/26/76
MINDIG__=9	;NO. OF DIGITS IF LS. WORD NOT SIGNIFICANT

BITNEG__40000
BITZ__100000
LZEROB__200000

ABLANK__40
APLUS__53
AMINUS__55
APOINT__56
AZERO__60
AD__104
AO__117
HEREFK(CVEL,CVEL.)
	DMOVE	AC,-2(P)	;FETCH THE ARGUMENT
	MOVE	USER,GOGTAB
	PUSHJ P,SAVE		;#ZF#
	PUSHJ	P,DOUBT.	;CONSTRUCT STRING
	MOVE LPSA,[3,,3]	;RET. WD AND LONG REAL	#ZF#
	JRST RESTR		;#ZF#
DOUBT.:
	MOVE	BITS,-1(P)	;GET FORMAT WORD
	TLZ	BITS,BITNEG+BITZ+LZEROB	;SET INDICATORS OFF
	JUMPE	AC,ZERO		;THE TRIVIAL CASE
	JUMPG	AC,POS		;IS NUMBER NEGATIVE?
	DFN	AC,AC+1		;YES, MAKE IT POSITIVE
	TLO	BITS,BITNEG	;REMEMBER THE MINUS
POS:	JUMPN	AC+1,POS1	;IF LS. WORD _ 0
	LDB	S,[POINT 9,AC,8] ;AND EXPONENT OF MS. WORD GT. 33
	CAIG	S,33
	TLO	BITS,LZEROB	;SET LZEROB
POS1:	MOVEI	IN,13		;TOP OF COMPARE TABLE
	MOVEI	XP,0		;INITIAL DECIMAL EXPONENT
	CAML	AC,TAB.P2	;IS NUMBER >_ 1.0?
	JRST	LUPP		;YES, BRING IT DOWN
	CAMN	AC,TAB.M1	;...
	CAML	AC+1,TAB.M2	;...
	CAMGE	AC,TAB.M1	;...
	JRST	LUPM		;YES, BRING IT UP
REND:	LDB	S,[POINT 9,AC,8];GET BINARY EXP
	TLZ	AC,777000	;CLEAR EXP OUT OF FRACTION
	ASHC	AC,8-200(S)	;MOVE FRACTION TO BINAL POINT
	MOVE	FR,AC		;PLACE IN FRACTION REGISTER
	MOVE	FR+1,AC+1	;...
ZEROH:
	MOVM	D$,DIGS(USER)	;DIGITS OF SIGNIFICANCE
	MOVM	W,WDTH(USER)	;WIDTH OF FIELD
	SETZ	S,		;SCALING
	JUMPN	W,DIGITS	;IS THIS UNSPECIFIED FORMAT?
	MOVEI	D$,MAXDIG	;YES, SET TO D$<MAXDIG>+8.<MAXDIG>
	MOVEI	W,MAXDIG+=8	;...
DIGITS:
	MOVEI	1,(W)
	ADDM	1,REMCHR(USER)
	SKIPLE	REMCHR(USER)
	 PUSHJ	P,STRNGC
	PUSH	SP,[-1,,0]	;INITIAL STRING
	PUSH	SP,TOPBYTE(USER)
	
	JUMPLE	S,.+2		;+ SCALE IMPLIES D$+1 DIGITS SIGNIFICANCE
	ADDI	D$,1
	MOVM	DIG,S		;DIGITS OF SCALING
	CAILE	D$,MAXDIG	;MAXIMUM SIGNIFICANCE EXCEEDED?
	MOVEI	D$,MAXDIG	;NO IT ISN'T.
	TLZN	BITS,LZEROB	;IF LZEROB SET
	JRST	.+3
	CAILE	D$,MINDIG	;CHECK NO MORE THAN
	MOVEI	D$,MINDIG	;ONE WORD OF DIGITS
	MOVE	R,D$		;SET ROUNDING POINT
	CAMGE	DIG,D$		;MAXF (S,D$)
	MOVE	DIG,D$		;...
	HRREI	IGN,-7(W)	;W-7-DIGITS	#ZF# CHANGE 6 TO 7
	SUBB	IGN,DIG		;...
	JUMPG	S,SCAL		;IF PLUS SCALE, THEN LEFT ROUTINE
SCAR:	JUMPLE	IGN,RNBLK	;JUMP IF NO LEADING BLANKS
	TLO	BITS,LZEROB	;SPACE FOR LEADING ZERO
	SOJE	DIG,RNBLK	;JUMP IF LEADING ZERO WAS ONLY SPACE
	MOVEI	AC,ABLANK	;ASCII BLANK
	PUSHJ	P,OUTCH		;OUTPUT IT
	SOJG	DIG,.-2		;JUMP IF MORE BLANKS
RNBLK:	ADD	R,S		;ONLY ROUND ON SIGNIFICANT DIGITS
	PUSHJ	P,SGNRND	;OUTPUT SIGN AND ROUND
	MOVEI	AC,AZERO	;LEADING ZERO
	TLNE	BITS,LZEROB	;WAS THERE SPACE FOR IT?
	PUSHJ	P,OUTCH		;YES, OUTPUT
	MOVEI	AC,APOINT	;MAY THERE ALWAYS BE A DECIMAL POINT
	PUSHJ	P,OUTCH		;...
	ADD	D$,S		;SCALE FACTOR IMPLIES EXTRA ZEROS
	JUMPGE	S,OGDIG		;NOT FOR THIS NUMBER
	MOVEI	AC,AZERO	;ASCII 0
	PUSHJ	P,OUTCH		;OUTPUT
	AOJL	S,.-2		;ANY MORE ZEROS?
	JRST	OGDIG		;NO.

SGNRND:	MOVEI	AC,ABLANK	;ASCII BLANK
	TLNE	BITS,BITNEG	;WAS NUMBER -?
	MOVEI	AC,100000+AMINUS	;ASCII MINUS
	PUSHJ	P,OUTCH		;OUTPUT SIGN
	JUMPL	R,NORND		;NOT ENUF TO ROUND
	CAILE	R,MAXDIG	;PERHAPS NO ROUND REQUIRED
	JRST	NORND		;ALL DIGITS OUTPUT
				;V.005 TO V.020 ON NEXT INSTRUCTION
	TLO	FR+1,400000	;SET SIGN BIT TO AVOID OVERFLOW
			;ON NEXT ADD. RNDL ENTRIES ARE ALWAYS .GE.0
	ADD	FR+1,RNDL(R)	;LO ORDER ROUND
				;V.005 TO V.020 ON NEXT 2 INSTRCTNS.
	TLO	FR,(1B0)	;TAKE CARE OF OVERFLOW TO HIGH WORD
	TLZN	FR+1,400000	;CLEAR BIT. WAS THERE CRY1?
	ADDI	FR,1		;YES. PROPOGATE CARRY
RND1:	ADD	FR,RNDH(R)	;HI ORDER ROUND
	TLC	FR,(1B0)	;BACK AS IT WAS UNLESS OVERFLOW
	JUMPGE	FR,NORND	;DID ROUND OVERFLO?
	MOVE	FR,[31463146314];YES,SET TO 0.1
	MOVE	FR+1,[314631463147]
	AOJA	XP,NORND	;INDICATE TO EXP
SCAL:	JUMPLE	IGN,LNBLK	;IS THERE SPACE FOR BLANKS?
	MOVEI	AC,ABLANK	;YES, OUTPUT SOME
	PUSHJ	P,OUTCH		;...
	SOJG	DIG,.-2		;OUTPUT SOME MORE
LNBLK:	SUB	D$,S		;SCALE DIGITS OF SIGNIF.
	HRREI	DIG,-MAXDIG(S)	;S-MAXIMUM SIGNIF
	JUMPLE	DIG,.+2		;IS S>MAXDIG?
	MOVEI	S,MAXDIG	;PROHIBIT PRINTOUT OF GIGO
	ADD	R,S		;ROUND AFTER SCALING DIGITS
	PUSHJ	P,SGNRND	;OUTPUT SIGN AND ROUND
	PUSHJ	P,OUTDIG	;DIGITS BEFORE DECIMAL POINT
	SOJG	S,.-1		;OUTPUT MOST OF SCALE DIGITS
	JUMPLE	DIG,DECPNT	;MORE SCALE DIGITS?
	MOVEI	AC,AO		;MAKE SURE THEY'RE INSIGNIFICANT
	PUSHJ	P,OUTCH		;...
	SOJG	DIG,.-2		;UNTIL SCALE FULFILLED
DECPNT:	MOVEI	AC,APOINT	;DECIMAL POINT
	PUSHJ	P,OUTCH		;...
OGDIG:	TLNE	BITS,BITZ		;IS THE NUMBER 0?
	JRST	ZEROP		;YES, PRINT 0
	JUMPLE	D$,EXPP		;ANY DIGITS REMAINING?
	PUSHJ	P,OUTDIG	;OUTPUT NEXT DIGIT
	SOJG	D$,.-1		;LOOP IF MORE DIGITS
EXPP:				;EXPONENT PRINT
	MOVEI	AC,"@"
	PUSHJ	P,OUTCH
	MOVEI	AC,"@"
	PUSHJ	P,OUTCH
	MOVEI	AC,APLUS	;ASCII +
	JUMPGE	XP,XTEN		;IS EXP +?
	MOVEI	AC,AMINUS	;NO, ASCII -
	MOVNS	XP		;MAKE EXP +
XTEN:	PUSHJ	P,OUTCH		;OUTPUT SIGN OF EXP
	IDIVI	XP,=100	;EXP MODULO 100.
	MOVE	XP,XP+1		;...
	IDIVI	XP,=10		;SPLIT INTO TWO DIGITS
	MOVEI	AC,60(XP)	;OUTPUT TENS DIGIT
	PUSHJ	P,OUTCH		;TENS POSITION
	MOVEI	AC,60(XP+1)	;OUTPUT UNITS DIGIT
	PUSHJ	P,OUTCH		;...
OVT:
NORND:	POPJ	P,
LUPP:	ASH	XP,1		;DECIAML EXPONENT *02
	CAMN	AC,TAB.P(IN)	;IS NUMBER NOW >_ TABLE
	CAML	AC+1,TAB.P1(IN)	;...
	CAMGE	AC,TAB.P(IN)	;...
	JRST	PNO		;NO, DON'T MULTIPLY
	MOVEI	Q,TAB.M(IN)	;MULTIPLY BY SELECTED NEGATIVE
	CAIE	IN,13		;E-32?
	JRST	NOTE32		;NO
	SUBI	Q,2		;USE E-16
	PUSHJ	P,DFM..		;TWICE
NOTE32:	PUSHJ	P,DFM..		;...
	ADDI	XP,1		;INDICATE MULTIPLICATION
PNO:	SOJL	IN,REND		;END OF TABLE?
	SOJG	IN,LUPP		;MOVE TABLE POINTER AND LOOP
	JRST	LUPP+1		;EXP IN RIGHT PLACE

LUPM:	ASH	XP,1		;DECIMAL EXPONENT * 2
	CAMN	AC,TAB.M(IN)	;IS NUMBER < TABLE?
	CAMGE	AC+1,TAB.M1(IN)	;...
	CAMLE	AC,TAB.M(IN)	;...
	JRST	MNO		;NO, DON'T MULTIPLY
	MOVEI	Q,TAB.P(IN)	;MULTIPLY BY SELECTED POSITIVE
	PUSHJ	P,DFM..		;...
	SUBI	XP,1		;INDICATE MULTIPLICATION
MNO:	SOJLE	IN,REND		;END OF TABLE?
	SOJA	IN,LUPM		;NO, MOVE TABLE POINTER AND LOOP
								; *EJG* 06/26/76
DFM..:	DFMP	AC,(Q)						; *EJG* 06/26/76
	JOV	.+1						; *EJG* 06/26/76
	POPJ	P,						; *EJG* 06/26/76
ZERO:	TLO	BITS,BITZ	;SET INDICATOR
	SETZB	FR,FR+1		;MAKE FRACTION PART 0
	JRST	ZEROH		;SCALING,IF NEEDED

ZEROP:	MOVEI	AC,"0"		;OUTPUT A ZERO
	PUSHJ	P,OUTCH		;...
	MOVEI	IN,3(D$)		;OUTPUT ENUF BLANKS
	MOVEI	AC,ABLANK	;ASCII BLANK
	PUSHJ	P,OUTCH		;...
	SOJG	IN,.-2		;...
	JRST	OVT		;GO RETURN

			;NEXT 11 INSTRUCTIONS CHANGE V.005 TO V.020
OUTDIG:	MOVE	MUL,FR+1	;MULTIPLY FRACTION BY 10.
	MULI	MUL,=10	;*LOW HALF BY 10.
	MOVE	FR+1,MUL+1	;STORE NEW LOW HALF IN FR+1
	MOVE	MUL+1,MUL	;SAVE LOW HALF CARRIES
	MOVE	AC,FR		;GET HIGH HALF OF FRACTION
	MULI	AC,=10		;* HIGH HALF BY 10.
	TLO	MUL,400000	;SET SIGN TO STOP OVERFLOW
	ADD	MUL,MUL+1	;ADD LOW HALF CARRIES TO HIGH HALF
	TLZN	MUL,400000	;CLEAR SIGN. WAS THERE CRY1?
	ADDI	AC,1		;YES, PROPOGATE CARRY
	MOVE	FR,MUL		;PUT HIGH PART OF NEW FRACTION BACK
	ADDI	AC,AZERO	;ASCII NUMBERS START AT 0

OUTCH:	AOJG	IGN,DEPOT.	;OUTPUT OR IGNORE?
	POPJ	P,		;RETURN

DEPOT.:	IDPB	AC,TOPBYTE(USER)
	AOS	-1(SP)
	POPJ	P,
	SUBTTL	ROUNDING TABLES
RNDH:	OCT	200000000000
	OCT	14631463146
	OCT	1217270243
	OCT	101422335
	OCT	6433342
	OCT	517426
	OCT	41433
	OCT	3265
	OCT	253
	OCT	21
	OCT	1
	OCT	0,0,0,0,0,0,0,0,0
RNDL:	OCT	0
	OCT	146314631464
	OCT	327024365604
	OCT	57065176763
	OCT	353070414545
	OCT	261070664360
	OCT	336405536661
	OCT	374515274536
	OCT	314356106043
	OCT	56027640466
	OCT	267633766353
	OCT	53765777027
	OCT	4313631402
	OCT	341134115
	OCT	26411156
	OCT	2200727
	OCT	163225
	OCT	13416
	OCT	1116
	OCT	73

DEFINE DEXP(A,B)<AB>

TAB.M=.+1							; *EJG* 07/01/76
	DEXP	175631463146,146314631463	;1.0E-1		; *EJG* 07/01/76
TAB.M2=.+1							; *EJG* 07/01/76
TAB.M1:	DEXP	175631463146,146314631463	;1.0E-1		; *EJG* 07/01/76
	DEXP	172507534121,353412172703	;1.0E-2		; *EJG* 07/01/76
	DEXP	163643334272,307041454513	;1.0E-4		; *EJG* 07/01/76
	DEXP	146527461670,214106071677	;1.0E-8		; *EJG* 07/01/76
	DEXP	113715126245,366104674127	;1.0E-16	; *EJG* 07/01/76
	DEXP	026637304365,152123462457	;1.0E-32	; *EJG* 07/01/76
								; *EJG* 07/01/76
TAB.P=.+1							; *EJG* 07/01/76
TAB.P2:	DEXP	201400000000,0			;1.0		; *EJG* 07/01/76
TAB.P1:	DEXP	204500000000,0			;1.0E+1		; *EJG* 07/01/76
	DEXP	207620000000,0			;1.0E+2		; *EJG* 07/01/76
	DEXP	216470400000,0			;1.0E+4		; *EJG* 07/01/76
	DEXP	233575360400,0			;1.0E+8		; *EJG* 07/01/76
	DEXP	266434157115,370100000000	;1.0E+16	; *EJG* 07/01/76
	DEXP	353473426555,101267026547	;1.0E+32	; *EJG* 07/01/76

BEND CVEL
ENDCOM(DVF)

IFN ALWAYS,<
BEND STRSER>
SUBTTL	IO SERVICE ROUTINES