perm filename STRSER.OLD[S,AIL]2 blob sn#073839 filedate 1973-11-28 generic text, type T, neo UTF8
COMMENT ⊗   VALID 00018 PAGES VERSION 17-1(3)
RECORD PAGE   DESCRIPTION
 00001 00001
 00003 00002	HISTORY
 00005 00003	Discussion
 00008 00004	COMPIL(CAT,<CAT,CATCHR,CHRCAT,CHRCHR,CAT.RV>
 00019 00005	COMPIL(PTC,<PUTCH>,<GOGTAB,STRNGC,INSET>,<PUTCH -- PUT 1 CHARACTER ROUT>)
 00021 00006	COMPIL(PNT,<POINT,BBPP.>,<GOGTAB,X22,X44>,<POINT, BBPP.>)
 00022 00007	COMPIL(CVF,<CVF,CVG,CVE>
 00026 00008	   CVF,CVE,CVG CONTD.
 00029 00009	  CVF,CVG,CVE CONTD.
 00031 00010	  CVF,CVG,CVE CONTD.
 00033 00011	  CVF,CVG,CVE CONTD.
 00035 00012	COMPIL(SUB,<SUBST,SUBSR>,<SAVE,RESTR,X22,.SKIP.,GOGTAB>,<SUBSTRING ROUTINES>)
 00040 00013	COMPIL(EQU,<EQU>,<X44>,<EQU>)
 00042 00014	COMPIL(CVD,<CVD,CVO>,<SAVE,RESTR,X11,X22>,<CVD AND CVO ROUTINES>)
 00044 00015	COMPIL(CVS,<GETFORMAT,SETFORMAT,CVS,CVOS>
 00049 00016	COMPIL(SCN,<SCAN>,<INSET,SAVE,RESTR,X44,STRNGC,BRKMSK>,<SCAN ROUTINE>)
 00053 00017	COMPIL(CVC,<CVSIX,CVASC,CVSTR,CVXSTR>,<SAVE,RESTR,X11,X22,INSET,STRNGC,FLSCAN>
 00057 00018	COMPIL(CVL,<CVFIL>,<SAVE,RESTR,X22,X33,FILNAM,.SKIP.>,<CVFIL>)
 00059 ENDMK
⊗;
COMMENT ⊗HISTORY
AUTHOR,REASON
021  102100000003  ⊗;


COMMENT ⊗
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 → 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 ↔ string conversions.
⊗
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

	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#
	HRRZ	A,-1(SP)	;#CHARS(2)
	ADDM	A,REMCHR(USER)	; - REMAINING CHARS
	SKIPLE	REMCHR(USER)	;ROOM?
	PUSHJ	P,STRNGC	;NO
	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 ≤ 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
	MOVEI X,"@"		;PUSH @
	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
	SETO FF,		;NUM IS NEG
	SETO A,
	LSHC A,11		;SEPERATE BIN EXPONENT
	LSH B,-1
	TLO B,400000
	SETCA A,		;BIN EXPONENT + 200
	MOVNS B
	TLN B,400000		;IS NUM LARGEST NEGATIVE
	JRST OK
	ASH B,-1		;WE WILL HAVE TO SHIFT AGAIN
	AOJA A,OK
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≤N LESS THAN 34
	JRST TOPQ
	CAIG A,30		;30.2≤N LESS THAN 33
	JRST BOT
DONE:	SUBI A,43		;31.2≤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≤N LESS THAN 34
	JRST MULTI 		;33.276 LESS THAN N LESS THAN 34
	JRST DONE		;33.2≤N≤33.276
BOT:	CAMGE B,LF		;30.2≤N≤30
	JRST FRACT		;30.2≤N LESS THAN 30.230
	JRST DONE		;30.230≤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≤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≤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≤N LESS THAN 33
	JRST L3			;31.2≤N LESS THAN 33
	CAMGE B,LF		;30.2≤N LESS THAN 31
	JRST L4			;30.2≤N LESS THAN 30.230
L3:	ASH D,(X)		;30.2300≤N LESS THAN 31
L9:	MOVNS D
	JRST DONE
L1:	CAIG A,34		;32.2≤N
	JRST L5			;32.2≤N LESS THAN 35
L8:	SUB A,.CH.(X)		;34.2≤N
	SOJA X,L2
L4:	SOJGE X,L2		;30.230≤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≤N LESS THAN 35
	JRST L6			;32.2≤N LESS THAN 33
	CAIL A,34		;33.2≤N LESS THAN 35
	JRST L7			;34.2≤N LESS THAN 35
	CAMG B,MF		;33.2≤N LESS THAN 34
	JRST L6			;33.2≤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⊃ZERO LENGTH REQUEST),>>
		LH(_SKIP_)←TRUE, SET START TO 1 OR LENGTH+1
 	4) ADJUST LENGTH AND BP IN DESCRIPTOR
 NOTICE THAT STR[∞+1 TO ∞+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
	ADDI	B,-"0"(X)
	SOJL	C,CVDUN		;DONE WHEN NEGATIVE
	ILDB	X,D
	JRST	CNV

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
	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(SCN,<SCAN>,<INSET,SAVE,RESTR,X44,STRNGC,BRKMSK>,<SCAN ROUTINE>)

DSCR "STR"←SCAN(@"STRING",BRKTBL,@BRCHAR);
CAL SAIL
⊗

HERE (SCAN)	PUSHJ	P,SAVE
	SKIPE	SGLIGN(USER)
	PUSHJ	P,INSET
	MOVE	LPSA,X44
	SOS	C,-3(P)		;→STRING TO BE SCANNED
	HRRZ	A,(C)		;#CHARS IN INPUT STRING
	ADDM	A,REMCHR(USER)
	SKIPLE	REMCHR(USER)	;THE "OUT OF SPACE DANCE"
	PUSHJ	P,STRNGC
	PUSH	SP,A
	PUSH	SP,TOPBYTE(USER) ;RESULT BYTE POINTER
	SKIPN	A
	JRST	NULSCN		;RETURN NULLS ALL AROUND
	MOVE	B,1(C)		;INPUT BYTE POINTER
	MOVEI	Z,0
	SOSL	CDB,-2(P)	;TABLE #, CHECK IT
	CAILE	CDB,=17		;FOR IN RANGE
	 ERR	 <SCAN: There are only 18 break tables>,1,SCNNR
SCNNX:	MOVE	D,BRKMSK+1(CDB)	;HAS BITS ON FOR THIS TABLE
	ADDI	CDB,1(USER)	;RLC+ORIG CHNL #
	SETZM	@-1(P)		;BREAK CHAR WORD
	HRRZ	Y,USER
	ADD	Y,[XWD	X,BRKTBL];RLC+BRKTBL(USER)

SCNLUP:	SOJL	A,SCNDUN	;STRING EXHAUSTED
	ILDB	X,B		;GET A CHAR
	TDNE	D,@Y		;TDNE D,BRKTBL+RLC(X)
	 JRST	 SCNSPC		;OMIT OR BREAK
	IDPB	X,TOPBYTE(USER)
	AOJA	Z,SCNLUP

SCNNR:	MOVNI	CDB,1		;USE TABLE 0;
	JRST	SCNNX
	
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(CDB) ;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
	SETZM	(SP)		;REAL NULL STRING RESULT
	JRST	RESTR
ENDCOM(SCN)
COMPIL(CVC,<CVSIX,CVASC,CVSTR,CVXSTR>,<SAVE,RESTR,X11,X22,INSET,STRNGC,FLSCAN>
	  ,<CVSIX, CVASC, CVSTR, CVXSTR -- 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)
	MOVEW	@TOPBYTE(USER),-1(P)
	AOS	TOPBYTE(USER)
	MOVE	LPSA,X22
	JRST	RESTR

DSCR "STR"←CVXSTR(SIXBIT INTEGER);
CAL SAIL
⊗

HERE (CVXSTR)
	PUSHJ	P,SAVE
	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
	
CVXLP:	ILDB	TEMP,B			;GET A SIXBIT CHAR
	ADDI	TEMP,40			;CONVERT TO ASCII
	IDPB	TEMP,TOPBYTE(USER)	;PUT IN RESULT STRING, UPDATE TOPBYTE
	SOJG	A,CVXLP			;DO IT ALL
	
	MOVE	LPSA,X22		;REMOVE ARG, RETURN ADDRESS
	JRST	RESTR			;AND RETURN

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.
	MOVE	LPSA,X33
	JRST	RESTR
ENDCOM(CVL)

IFN ALWAYS,<
BEND STRSER>
SUBTTL	IO SERVICE ROUTINES