;*********
;        *
; BASIC1 *
;        *
;*********
	.TITLE	BASIC1
;
; FPP OBJECT MODULE FOR BASIC  1 JUNE 72
;
; DOS VERSION FROM WHICH THE RSX VERSION EVOLVED WAS ORIGIANLLY A DECUS
; LIBRARY PROGRAM MODIFIED BY FRANK KORZENIEWSKI OF RPSLMC.
;
; MODIFIED FOR OPERATION UNDER RSX BY LARRY SIMPSON & FRANK BORGER
; SEP-75
;
; MODIFIED TO USE FORTRAN FUNCTION MODULES 1-JUN-77 -- LARRY SIMPSON
;
; TRANSFER OF ALL BUILT-IN FUNCTIONS FROM BASIC2 MAY-78
;                                                                               ;DSS1
; CHANGED FLOATING POINT OUTPUT TO 6 SIGNIF. DIGITS (CONDITIONAL ON FPPEMU)     ;DSS1
; TO REFLECT SUPPORT FOR FPP EMULATION (FOR 11/40 FIS)                          ;DSS1
; CONDITIONAL ON  FPPEMU  (DEFINED IN PREFIX FILE)                              ;DSS1
; DANIEL STEINBERG 20-FEB-78                                                    ;DSS1
;                                                                               ;DSS1
; MODIFIED FLOATING POINT OUTPUT ROUTINE (FTOA00) TO PRINT IN STANDARD          ;DSS1
; SCIENTIFIC NOTATION  (EG. 3.0E14  RATHER THAN  3E14)                          ;DSS1
; D.S.                                                                          ;DSS1

	.SBTTL	JSR MACRO DEFINITIONS
	;CODE TO CONVERT TRAP SUBROUTINE CALLS TO NORMAL JSR'S
	;FOR OPERATION UNDER RSX.
	;
	;DEFINE A GENERAL MACRO TO GENERATE A SECOND MACRO WHICH
	;CONVERTS A TRAP NAME OF XXXXXX TO A
	;	JSR	PC,XXXXXX
	;
	.MACRO TRPSUB	A,B
	.MACRO	A
	JSR	PC,B
	.ENDM
	.ENDM
;
;	NOW ALL THE ONE-TIME TRAPS THAT BASIC USES
;
	TRPSUB	ATOF,ATOF00	;ASCII TO FLOATING
	TRPSUB	EVAL,EVAL00	;EVALUATE ARITHMETIC EXPRESSION
	TRPSUB	EVALS,EVLS00	;EVALUATE STRING EXPRESSION
	TRPSUB	ITOA,ITOA00	;CONVERT INTEGER TO ASCII
	TRPSUB	SKIP,SKIP00	;SKIP OVER SPACES IN INPUT TEXT
	TRPSUB	TSTCH,TST00	;TEST CHAR (IN R2) ALPHA VS NUMERIC
	TRPSUB	TSTOK,TSTU00	;CHECK, IS THERE ENOUGH USER SPACE

	.SBTTL	GLOBAL DEFINITIONS
;
; GLOBALS--ERROR CALLS
;
	.GLOBL	OVFERR	ILFERR	SBSERR	VALERR
	.GLOBL	STXERR	FNMERR	LNNERR
;
;
; GLOBALS--SYSTEM VARIABLES
;
	.GLOBL	ENUDAT	STGOSB
	.GLOBL	PARLST	P.ERCD	P.LINE	P.FCS
;
; GLOBALS--STRING FUNCTION ENTRY POINTS
;
	.GLOBL	SBS00	SEG00	RJS00	LJS00	FCHR00
	.GLOBL	TRM00	LTR00	DAT00	TIM00	CHR00
	.GLOBL	OCT00	OCS00	LEFT00	RIGHT0	DDAT00
	.GLOBL	PIECE0	SPACE0	STRG00	R5A00
;
; GLOBALS--NUMERIC FUNCTION ENTRY POINTS
	.GLOBL	INX00	NRC00	LEN00	VAL00	ASC00
	.GLOBL	OCB00	COR00	ERR00	ERL00	FCS00
	.GLOBL	AR500	DCEN0	FORM00	SEC00

;
; GLOBALS--ARITHMETIC FUNCTION ENTRY POINTS
;
	.GLOBL	ATOF00	ATOI00	ITOA00
;
	.GLOBL	SINE00	COS00	ATN00	EXPF00	LOG00
	.GLOBL	ABS00	SQRT00	INT00	RND00	SGN00
	.GLOBL	PWRF00	RND01	M.I	FTOA00	TIMBUF
	.GLOBL	LOG10
;
; GLOBALS--RETURNS TO MAIN--AND SYSTEM VARIABLES
;
	.GLOBL	INIT02	TSTU00	TST00	STRCMP	SRCHFL
	.GLOBL	SKIP00
;
; GLOBALS--FORTRAN FUNCTION MODULE ENTRY POINTS
;
	.GLOBL	SQRT	SIN	COS	ATAN	EXP	ALOG
;
;
; REGISTER ASSIGNMENTS
;
R0	=	%0		;TEMPORARY AND PARAMETER TRANSFER
R1	=	%1		;TEMPORARY AND PARAMETER TRANSFER
R2	=	%2		;SCRATCH
R3	=	%3		;SCRATCH
R4	=	%4		;SCRATCH
R5	=	%5		;USER LIST POINTER
SP	=	%6		;BASIC STACK POINTER
PC	=	%7		;PROGRAM COUNTER
;
AC0	=	%0		;F.P. REGISTER 0
AC1	=	%1		;F.P. REGISTER 1
AC2	=	%2		;F.P. REGISTER 2
AC3	=	%3		;F.P. REGISTER 3
AC4	=	%4		;F.P. REGISTER 4
;
;RSX MACRO CALLS
;
	.MCALL	GTIM$S
;
;PDP-11 FLOATING POINT PACKAGE
;

	.SBTTL	RND00 - RANDOM NUMBER GENERATOR
	.PSECT	BASIC1,RW,I,LCL,REL,CON
;+4
; .SL
; .X <RND
; .HEADERLEVEL 1 <RND
; .BR
; ^THIS FUNCTION RETURNS A RANDOM NUMBER EVENLY DISTRIBUTED BETWEEN
; 0 AND 1.
; ^THE DUMMY ARGUMENT HAS NO EFFECT ON THE VALUE RETURNED.
; ^THE SEQUENCE OF NUMBERS RETURNED MAY BE CHANGED BY USING THE
; <RANDOMIZE STATEMENT.
; .BR
; ^EXAMPLE:
; .NF
; ^^
; 	{120 X=RND(0)}
; \\
; .F
;-
RND00:	MOV	M.I,R2		;GET THE LAST NUMBER
	MOV	M.K,R3		;GET THE GENERATOR
	MUL	R2,R3
	BIC	#100000,R3	;CLEAR SIGN BIT
	MOV	R3,M.I		;SAVE FOR NEXT TIME
	LDCIF	R3,AC0		;FLOAT IT
	STEXP	AC0,R3		;MUST ADJUST EXPONENT
	SUB	#17,R3
	LDEXP	R3,AC0		;RELOAD IT
	RTS	PC
M.K:	.WORD	403		;=64*8+3
	.PSECT	BASIC1
;+4
; .SKIP
; .X ^^RANDOMIZE\\
; .HEADERLEVEL 1 <RANDOMIZE
; .BREAK
; ^THIS STATEMENT RESETS THE RANDOM NUMBER GENERATOR TO A NEW STARTING
; POINT.
; ^THE EFFECT OF THIS IS TO MAKE SUCCESSIVE RUNS OF THE SAME PROGRAM
; RETURN DIFFERENT VALUES FOR THE ^^RND\\ FUNCTION.
; ^A PROGRAM SHOULD FIRST BE DEBUGGED WITHOUT THE ^^RANDOMIZE\\
; STATEMENT AND THEN ADD IT FOR PRODUCTION USE.
; .BREAK
; ^EXAMPLE:
; .NOFILL
; ^^
;	{50 RANDOMIZE}
; \\
; .FILL
;-
RND01:	GTIM$S	#TIMBUF		;GET TIME PARAMETERS IN THE BUFFER
	MOV	R0,-(SP)	;SAVE R0 TEMPORARILY
	MOV	TIMBUF+G.TISC,R0;GET SECONDS IN R0
	ASH	#6,R0		;SHIFT OVER
	ADD	TIMBUF+G.TICT,R0;ADD IN THE COUNTS
	MOV	R0,M.I		;PUT IT AWAY
	MOV	(SP)+,R0	;RESTORE R0
	BIS	#1,M.I		;MAKE IT ODD
	JMP	INIT02

	.SBTTL	ATOF00 - ASCII TO FLOATING CONVERSION
; ON ENTRY:
;	R1 POINTS TO START OF NUMERIC STRING
; ON EXIT:
;	V-BIT IS SET IF ERROR
; OTHER REGISTERS USED: R2, R3, R4
;	R1 POINTS TO FIRST NON-NUMERIC CHAR.
;
ATOF00:	MOV	R5,-(SP)	;SAVE R5
	MOV	R0,-(SP)	;SAVE THE DEFA
	CLRF	AC0		;SLOT FOR RESULT
	CLR	-(SP)		;CLEAR EXP1
	CLR	-(SP)		;CLEAR EXP2
	CLR	-(SP)		;CLEAR THE SWITCHES
	SKIP			;GET A CHARACTER FROM THE INPUT STRING
	BR	M.AFX1		;DON'T NEED TO GET ANOTHER CHAR
M.AFXN:	MOVB	(R1)+,R2	;GET ANOTHER CHAR, EVEN IF SPACE
M.AFX1:	CMPB	#105,R2		;LOOK FOR AN E
	BEQ	M.AFE		;BRANCH IF AN E IS FOUND
	CMPB	#55,R2		;LOOK FOR A MINUS
	BEQ	M.AFMI		;BRANCH IF A MINUS SIGN
	CMPB	#53,R2		;LOOK FOR A PLUS
	BEQ	M.AFPL		;BRANCH IF A PLUS SIGN
	CMPB	#56,R2		;LOOK FOR A DECIMAL POINT
	BEQ	M.AFD		;BRANCH IF A DECIMAL POINT
	TSTCH			;MAKE SURE IT IS NUMERIC
	BNE	M.AFTX		;ERROR IF NOT NUMERIC
	SUB	#60,R2		;CONVERT TO A BINARY NUMBER
	BIT	#4,@SP		;TEST THE E SWITCH
	BNE	M.AFXP		;BRANCH IF COLLECTING EXPONENT
	LDCIF	R2,AC1		;FLOAT THE DIGIT
	MULF	M.TEN,AC0	;ADJUST PREV DIGITS
	CFCC			;CHECK CONCODES
	BVS	M.AFVS		;OVERFLOW IS A NO-NO
	ADDF	AC1,AC0		;ADD IN CURRENT DIGIT
	BIT	#10,@SP		;TEST THE D SWITCH
	BEQ	M.AFSS		;IF ZERO DON'T TOUCH EXP2
	DEC	2(SP)		;DECREMENT EXP2
M.AFSS:	BIS	#1,@SP		;SET THE S SWITCH
	BR	M.AFXN		;GO GET MORE STUFF

M.AFXP:	MOV	4(SP),R3	;GET THE OLD EXPONENT
	MUL	#10.,R3		;SHIFT PREV DIGITS
	ADD	R2,R3		;ADD IN CURRENT GUY
	CMP	#127.,R3	;CHECK FOR OVERFLOW
	BLT	M.AFVS		;JUMP ON ERROR
	MOV	R3,4(SP)	;SAVE IT BACK ON THE STACK
	BR	M.AFSS		;SET S SWITCH
M.AFE:	BIT	#4,@SP		;SEE IF THIS IS THE FIRST E
	BNE	M.AFVS		;ERROR IF MORE THAN ONE E
	BIS	#4,@SP		;SET THE E SWITCH
	BIC	#1,@SP		;CLEAR THE S SWITCH
	MOVB	(R1),R2		;NEXT CHAR IN R2
	TSTCH			;CHECK FOR NUMERIC
	BEQ	M.AFXN		;IF NUMERIC, CONTINUE
	CMPB	R2,#'-		;COULD BE LEADING MINUS
	BEQ	M.AFXN		;IF SO, OK
	CMPB	R2,#'+		;OR PLUS
	BEQ	M.AFXN		;ALSO OK
	BIS	#2,(SP)		;SET 'V' FLAG
	BR	M.AFX5		;AND GO EXIT ROUTINE
M.AFD:	BIT	#14,@SP		;TEST E AND D SWITCHES
	BNE	M.AFVS		;EITHER ONE SET IS AN ERRROR
	BIS	#10,@SP		;SET THE D SWITCH
	BR	M.AFXN		;SET START OF SIGNIFICANCE
M.AFPL:	BIC	#400,@SP	;CLEAR THE M SWITCH
	BR	.+6	;->	;SKIP THE NEXT INSTRUCTION
M.AFMI:	BIS	#400,@SP;  I	;SET THE M SWITCH
	BIT	#4,@SP	;<-	;TEST THE E SWITCH
	BNE	M.AFSE		;BRANCH IF SIGN OF THE EXPONENT
	BIT	#1,@SP
	BNE	M.AFTX
	BIT	#30,@SP		;TEST THE A, D, AND S SWITCHES
	BNE	M.AFVS		;IF EITHER IS SET AN ERROR IS HERE
	BIS	#20,@SP		;SET THE A SWITCH
	BIT	#400,@SP	;TEST IF A MINUS SIGN
	BEQ	M.AFXN		;RETURN IF PLUS SIGN
	BIS	#100,@SP	;SET MINUS SIGN
	BR	M.AFXN		;GET THE NEXT CHARACTER
M.AFSE:	BIT	#01,@SP		;TEST B AND S SWITCHES
	BNE	M.AFTX		;ERROR IF EITHER IS SET
	BIT	@SP,#40
	BNE	M.AFVS
	BIS	#40,@SP		;SET THE B SWITCH
	BIT	#400,@SP	;TEST FOR A MINUS SIGN
	BEQ	M.AFXN		;EXIT IF A PLUS
	BIS	#200,@SP	;SET MINUS EXPONENT
	BR	M.AFXN		;GET NEXT CHARACTER
M.AFVS:	BIS	#2,@SP		;SET V SWITCH
	BR	M.AFTX

M.AFTX:	BIT	#100,@SP	;SEE IF IT SHOULD BE NEGATIVE
	BEQ	M.AFX2		;BRANCH OF NO CONVERSION
	NEGF	AC0		;NEGATE THE NUMBER
M.AFX2:	BIT	#200,@SP	;SEE IF A NEGATIVE EXPONENT
	BEQ	M.AFX3		;BRANCH IF NO NEGATION
	NEG	4(SP)		;NEGATE THE EXPONENT
	BVC	M.AFX3		;TEST FOR VALID EXPONENT
	BIS	#2,@SP		;SET THE V BIT
	BR	M.AFX5		;EXIT WITH ERROR
M.AFX3:	ADD	2(SP),4(SP)	;REMEMBER ANY DECIMAL PLACES
	BEQ	M.AFX5		;BRANCH IF NO CONVERSION
	BLT	M.AFDV		;IF LESS THEN ZERO DIVIDE
M.AFX4:	MOV	4(SP),R3	;CALC SHIFT CONSTANT
	LDCIF	#10.,AC1	;FLOAT SHIFT CONSTANT
1$:	MULF	AC1,AC0		;ADJUST NUMBER
	SOB	R3,1$		;REDUCE BY EXPON
	BR	M.AFX5		;BYPASS DIVIDE SECTION
M.AFDV:	MOV	4(SP),R3	;CALC SHIFT CONSTANT
	NEG	R3		;MAKE IT POSITIVE
	LDCIF	#10.,AC1	;FLOAT IT
1$:	DIVF	AC1,AC0		;SHIFT DIGITS OVER
	SOB	R3,1$		;LOOP ON EXPON
M.AFX5:	DEC	R1		;POINT TO DELIMITER
	MOV	(SP)+,R4	;SAVE THE SWITCHES
	CMP	(SP)+,(SP)+	;REMOVE EXP2+EXP1 FROM STACK
	MOV	(SP)+,R0	;RESTORE R0
	MOV	(SP)+,R5	;RESTORE R5
	BIT	#2,R4		;TEST FOR V SETTING
	BEQ	1$		;->
	SEV			;ASCII ERROR
1$:	RTS	PC
M.TEN:	.FLT2	10.		;FLOATING POINT 10.
M.ONE:	.FLT2	1.		;FLOATING POINT 1.

	.SBTTL	FTOA00 - FLOATING POINT TO ASCII ROUTINE
;
; FTOA - FLOATING POINT TO ASCII ROUTINE
;
	.IF	DF,FPPEMU	;IF FIS...SEVENTH DIGIT IS BAD                  ;DSS1
PRECIS=6		;# DIGITS OF PRECISION (6 FOR FPP EMULATION)            ;DSS1
	.IFF			; IF FPP...SEVEN DIGITS OK                      ;DSS1
PRECIS=7                                                                        ;DSS1
	.ENDC                                                                   ;DSS1
;                                                                               ;DSS1
FTOA00:	CLR	-(SP)		;CONVERT FROM
	CLR	-(SP)		;2 WORD FLOATING
	STF	AC0,-(SP)	;POINT TO 4 WORD
	SETD			;FLOATING
	LDD	(SP)+,AC0	;POINT
	MOV	#12,R0		;PUT SOME WORDS ON THE STACK
	CLR	-(SP)		;CLEAR A WORD OF STACK
	DEC	R0		;DECREMENT THE COUNTER
	BGT	.-4		;LOOP IF MORE TO DO
	MOV	#030040,2(SP)	;MOVE A SP 0 TO THE OUTPUT
	MOV	#40,4(SP)	;FOLLOW WITH A SPACE AND NULL
	TSTD	AC0		;TEST THE SIGN OF THE NUMBER
	CFCC			;GET CONCODES
	BEQ	M.XAXT		;IF 0 WE'RE DONE ALREADY
	BGT	M.XA1		;IF NEGATIVE MAKE POSITIVE
	NEGD	AC0		;MAKE IT PLUS
	MOVB	#55,2(SP)	;MOVE IN A - SIGN
M.XA1:	CMPD	M.ONED,AC0	;START RANGING - COMPARE 1:#
	CFCC
	BLE	M.XA3		;BRANCH IF TOO SMALL
M.XA2:	CMPD	M.PT1,AC0	;CHECK .1:#
	CFCC
	BLE	M.XA4		;BRANCH IF RANGING IS DONE
	MULD	M.TEND,AC0	;JACK IT UP
	DEC	@SP		;MAKE THE EXPONENT SMALLER
	BR	M.XA2		;SEE IF IT'S BIG ENOUGH
M.XA3:	DIVD	M.TEND,AC0	;PULL IT DOWN A BIT
	INC	@SP		;MAKE THE EXPONENT LARGER
	BR	M.XA1		;SEE IF IT'S IN RANGE YET
M.XA4:	ADDD	M.FIVD,AC0	;ROUND IT UP
;HERE MAKE SURE RANGING WAS DONE PROPER
	STD	AC0,AC2		;COPY IT
	MODD	M.TEND,AC2	;DO TRIAL DIGIT STRIP
	STCDI	AC3,-(SP)	;INTEGER IT
	CMP	(SP)+,#9.	;A SCREW UP?????
	BLE	M.XA13		;JUMP IF ALL OK
	DIVD	M.TEND,AC0	;ADJUST
	INC	@SP
M.XA13:	MOV	@SP,R0		;CHECK MAGNITUDE OF EXPONENT
	BPL	.+4	;->	;SKIP IF POSITIVE
	NEG	R0	;  I	;ELSE MAKE POSITIVE
	CMP	R0,#99.	;<-	;IS EXPON TOO LARGE
	BGT	M.XAXT		;EXIT IF SO
	MOV	SP,R0		;POINT TO OUTPUT AREA
	ADD	#3,R0
;HERE CALC NUMBER OF SIGNIFICANT DIGITS IN NUMBER
	STD	AC0,AC2		;USE AC2-AC3
	MOV	#PRECIS,R3	;MAX SIGNIF DIGITS                              ;DSS1
	CLR	R2		;SLOT FOR TRAIL ZERO COUNT                      ;**-1
M.XA5:	MODD	M.TEND,AC2	;STRIP A DIGIT
	DEC	R2		;ZERO'D IF NOT A ZERO DIGIT
	TSTF	AC3		;CHECK FOR ZERO DIGIT
	CFCC
	BEQ	.+4	;->	;COUNT IT IF NOT ZERO
	CLR	R2	;  I	;ELSE RESET COUNT
	SOB	R3,M.XA5;<-	;LOOP FOR (PRECIS) DIGITS                       ;DSS1
;NOW CHECK FOR F OR E FORMAT REQUIRED                                           ;DSS1
	CMP	@SP,#PRECIS+1	;IF NUM>10^PRECIS                               ;DSS1
	BGE	M.ZEA0		;JUMP IF E FOR SURE                             ;DSS1
	CMP	@SP,#1-PRECIS	;IF NUM<10^(-PRECIS)                            ;DSS1
	BLT	M.ZEA0		;JUMP IF E FOR SURE                             ;DSS1
	TST	@SP		;IF 10^0 THRU 10^(PRECIS)                       ;DSS1
	BPL	.+6	;->	;ITS F FOR SURE                                 ;DSS1
	TST	R2	;  I	;BUT NUM<10^0 AND (PRECIS) SIGNIF DIGITS        ;DSS1
	BEQ	M.ZEA0	;  I	;ITS E FOR SURE                                 ;DSS1
	ADD	#PRECIS,R2;<-	;MAKE TRAIL BLANK COUNT TO SIGNIF COUNT         ;DSS1
	MOV	(SP)+,R3	;GET 10^X POWER                                 ;**-11
	MOV	#M.XA9,-(SP)	;SET RETURN ADDRESS
	NEG	R3		;CHECK FOR DIGITS TO LEFT  OF D.P.
	BGT	M.XA11		;JUMP IF NO INTEGER DIGITS
	BEQ	M.XA12		;BR IF NO ZERO PADD
	NEG	R3		;MAKE POSITIVE AGAIN
;SUBROUTINE TO CONVERT FLOATING DIGITS TO ASCII
M.XA6:	MODD	M.TEND,AC0	;STRIP A DIGIT (LOVE THAT INSTRUCTION)
	STCDI	AC1,-(SP)	;MAKE INTEGER (THIS ONE TOO)
	ADD	#60,@SP		;NOW MAKE ASCII
	MOVB	(SP)+,(R0)+	;PUT IN OUTPUT AREA
	DEC	R2		;ACCOUNT FOR SIGNIF DIGIT
	SOB	R3,M.XA6	;LOOP ON DIGITS WANTED COUNT
M.XA12:	MOV	R2,R3		;MORE SIGNIF DIGITS LEFT
	BLE	M.XA8		;EXIT IF NONE LEFT
M.XA7:	MOVB	#56,(R0)+	;MOVE IN DEC. PT.
	CLR	R2		;ZAP FLAG TO FORCE EXIT NEXT TIME
	BR	M.XA6		;REDO SUBROUTINE
M.XA8:	RTS	PC		;THIS EXITS INTERNAL SUB (STILL IN FTOA)
M.XA11:	MOVB	#56,(R0)+	;D.P. THEN ZERO PADD
	MOVB	#60,(R0)+	;PADD
	SOB	R3,.-4		;LOOP ON EXPON
	MOV	R2,R3		;SET ALL SIGNIF DIGITS WANTED
	CLR	R2		;ZAP TWO PASS FLAG
	BR	M.XA6		;DO INTERNAL SUB
;EXITING FTOA ROUTINE
M.XA9:	MOVB	#40,(R0)+	;BLANK AT END
	CLRB	@R0		;FOLLOWED BY ZERO BYTE
M.XA10:	SETF			;RESTORE 2 WORD MODE
	MOV	22(SP),PC	;AND EXIT FTOA
M.XAXT:	TST	(SP)+		;POP GARBAGE
	BR	M.XA10		;AND EXIT
;HERE WE COME IF E FORMAT REQUIRED
M.ZEA0:	MOV	#1,R3		;SET CHAR COUNT BEFORE DECIMAL POINT            ;DSS1
	ADD	#PRECIS,R2	;SET TOTAL CHAR COUNT                           ;DSS1
	CMP	R2,R3		;ONLY ONE?                                      ;DSS1
	BGT	1$                                                              ;DSS1
	INC	R2		;YES...PRINT 3.0E14 INSTEAD OF 3E14             ;DSS1
1$:	JSR	PC,M.XA6	;OUTPUT A DIGIT, D.P., AND THE REST             ;DSS1
	MOVB	#105,(R0)+	;OUTPUT 'E'                                     ;DSS1
	MOV	R1,R4		;SAVE TEXT POINTER                              ;DSS1
	MOV	(SP)+,R1	;GET EXPONENT                                   ;DSS1
	DEC	R1		;ADJUST (PRINT ROUTINE MULTIPLIED BY 10)        ;DSS1
	CLR	R2		;SET NO LEADING ZEROES                          ;**-6
	JSR	PC,$CBDSG	;CONVERT EXPONENT TO ASCII (WITH SIGN)
	MOV	R4,R1		;RESTORE TEXT POINTER
	BR	M.XA9		;AND DO EXIT STUFF
M.ONED:	.FLT4	1.		;FLOATING POINT 1.
M.PT1:	.FLT4	.1		;FLOATING POINT .1
M.TEND:	.FLT4	10.		;FLOATING POINT 10.
                                                                                ;DSS1
	.IF	EQ,PRECIS-7	;IF 7 DIGIT PRECISION                           ;DSS1
M.FIVD:	.FLT4	.00000005	;FLOATING POINT .5                              ;DSS1
	.ENDC                                                                   ;DSS1
                                                                                ;DSS1
	.IF	EQ,PRECIS-6	;IF 6 DIGIT PRECISION                           ;DSS1
M.FIVD:	.FLT4	.0000005	;FLOATING POINT .5                              ;DSS1
	.ENDC                                                                   ;DSS1

	.SBTTL	ITOA00 - INTEGER TO ASCII CONVERSION
;
; ITOA - INTEGER TO ASCII ROUTINE
; ON ENTRY:
;	R0 CONTAINS ADDRESS OF OUTPUT STRING
;	R1 CONTAINS NUMBER TO CONVERT
;
ITOA00:	CLR	R2		;INDICATE NO LEADING ZEROES
	JSR	PC,$CBDMG	;USE LIBRARY CONVERSION ROUTINE
	CLRB	(R0)		;SET ZERO FLAG AT END
	RTS	PC

	.SBTTL	ATOI00 - ASCII TO INTEGER CONVERSION
;
; ASCII TO INTEGER ROUTINE
; USED FOR LINE NUMBER CONVERSION
;
ATOI00:
	SKIP			;NEXT CHAR -> R2
	DEC	R1		;BACK UP SO POINT TO IT WITH R1
	MOV	R1,R0		;COPY START -> R0
	JSR	PC,$CDTB	;CONVERTED NUMBER -> R1
	DEC	R0		;BACK UP TEXT PTR
	MOV	R1,R2		;COPY RESULT -> R2
	MOV	R0,R1		;ADDRESS PAST END OF NUMBER -> R1
	MOV	R2,R0		;RESULT -> R0
	RTS	PC

	.SBTTL	ABS00 - ABSOLUTE VALUE FUNCTION
;+4
; .SKIP
; .X ^^ABS\\
; .X ^ABSOLUTE VALUE FUNCTION
; .HEADERLEVEL 1 <ABS
; .BREAK
; ^THIS FUNCTION RETURNS THE ABSOLUTE VALUE OF THE NUMERIC
; EXPRESSION ARGUMENT.
; .BREAK
; ^EXAMPLE:
; .NOFILL
; ^^
;	{10 A=ABS(A1+5)}
; \\
; .FILL
;-
ABS00:	ABSF	AC0		;TAKE ABS
	RTS	PC		;AND RETURN
	.SBTTL	SGN00 - GET SIGN OF OPERAND
;+4
; .SKIP
; .X ^^SGN\\
; .X ^SIGN FUNCTION
; .HEADERLEVEL 1 <SGN
; .BREAK
; +1 RETURNED IF ARGUMENT > 0; -1 IF ARGUMENT < 0;
; 0 RETURNED IF ARGUMENT = 0.
; .BREAK
; ^EXAMPLE:
; .NOFILL
; ^^
;	{10 A=SGN(A1)}
; \\
; .FILL
;-
SGN00:	TSTF	AC0		;CHECK IT FOR SIGN
	CFCC
	BGT	SGN01		;+1 FOR >0
	BEQ	SGN02		;IF ZERO PASS 0 BACK
	LDCIF	#-1,AC0		;PASS -1 FOR <0
	RTS	PC		;AND RETURN
SGN01:	LDCIF	#1,AC0		;PASS +1 FOR >0
SGN02:	RTS	PC		;AND RETURN

	.SBTTL	INT00 - GET INTEGER PART OF NUMBER
;+4
; .SKIP
; .X ^^INT\\
; .X ^INTEGER FUNCTION
; .HEADERLEVEL 1 <INT
; .BREAK
; ^RETURNS GREATEST INTEGER IN THE ARGUMENT.
; ^NOTE: ^^INT(-1.5)=-2\\ ETC.
; .BREAK
; ^EXAMPLE:
; .NOFILL
; ^^
;	{10 A=INT(X)}
; \\
; .FILL
;-
INT00:	MODF	M.ONE,AC0	;GET INT IN AC1, FRAC IN AC0
	TSTF	AC0		;WAS THERE NEG FRACTION LEFT
	CFCC
	BGE	1$		;IF NOT, SKIP
	SUBF	M.ONE,AC1	;IF SO, CORRECT RESULT FOR GREATEST INTEGER
1$:	LDF	AC1,AC0		;PASS BACK INTEGER PART
	RTS	PC		;AND RETURN
	.SBTTL	PWRF00 - POWER FUNCTION
;
; POWER FUNCTION
;
PWRF00:	STF	AC1,AC4		;SAVE NUMBER
	STF	AC1,AC2		;CHECK FOR INTEGER
	MODF	M.ONE,AC2	;INT -> AC3, FRAC -> AC2
	TSTF	AC2		;ANY FRACTION?
	CFCC
	BEQ	1$		;IF NO FRACTION, DO DIFFERENT ROUTINE
	MOV	R5,-(SP)	;SAVE R5
	JSR	PC,LOG00	;GET IT
	MULF	AC4,AC0		;GET AC0*LOG(AC1)
	JSR	PC,EXPF00	;GET EXP(AC0*LOG(AC1))
	MOV	(SP)+,R5	;RESTORE R5
	RTS	PC		;AND RETURN
1$:	STCFI	AC3,R0		;STORE INTEGER POWER IN R0
	LDF	AC0,AC1		;REPEAT NUMBER
	DEC	R0		;DEC POWER (ALREADY HAVE FIRST)
	BEQ	2$		;IF NOW 0 (WAS 1), RETURN
	BLT	3$		;IF NEG, DO DIVIDE ROUTINE
4$:	MULF	AC1,AC0		;DO IT
	SOB	R0,4$		;R0 TIMES
	BR	2$
3$:	NEG	R0		;GET # OF TIMES TO DIVIDE
5$:	DIVF	AC1,AC0		;DO IT
	SOB	R0,5$		;R0 TIMES
2$:	RTS	PC

	.SBTTL	LOG00 - FLOATING POINT NATURAL LOG ROUTINE
;+4
; .SKIP
; .X ^^LOG\\
; .X ^LOGARITHM - NATURAL
; .HEADERLEVEL 1 <LOG (NATURAL _& BASE 10)
; <LOG
; .BREAK
; ^RETURNS THE NATURAL LOG OF THE VALUE OF THE ARGUMENT EXPRESSION.
; .BREAK
; ^EXAMPLE:
; .NOFILL
; ^^
;	{30 A=LOG(X)}
; \\
; .FILL
; .S
; .X <LOG10
; .X ^LOGARITHM - BASE TEN
; <LOG10
; .BREAK
; ^RETURNS THE BASE TEN (COMMON) LOG OF THE VALUE OF THE ARGUMENT
; EXPRESSION
; .BREAK
; ^EXAMPLE:
; .NF
; ^^
; 	{50 B=LOG10(X)}
; \\
; .F
;-
;
LOG00:	MOV	#ALOG,R0	;ADDRESS OF FORTRAN NATURAL LOG ROUTINE -> R0
	BR	FNSTRT		;BRANCH TO COMMON FUNCTION PROCESSING
LOG10:	MOV	#ALOG10,R0
	BR	FNSTRT

	.SBTTL	EXPF00 - FLOATING POINT EXPONENTIAL ROUTINE
;+4
; .SKIP
; .X ^^EXP\\
; .X ^EXPONENTIAL FUNCTION
; .HEADERLEVEL 1 <EXP
; .BREAK
; ^RETURNS THE BASE E EXPONENTIAL OF THE ARGUMENT VALUE.
; .BREAK
; ^EXAMPLE:
; .NOFILL
; ^^
;	{10 A=EXP(X)}
; \\
; .FILL
;-
;
EXPF00:	MOV	#EXP,R0		;ADDRESS OF FORTRAN EXPONENTIAL ROUTINE -> R0
	BR	FNSTRT		;BRANCH TO COMMON PROCESSING

	.SBTTL	SIN00 - SINE FUNCTION
;+4
; .SKIP
; .X ^^SIN\\
; .X ^^COS\\
; .X ^SINE FUNCTION
; .X ^COSINE FUNCTION
; .HEADERLEVEL 1 <SIN <COS
; .BREAK
; ^THESE FUNCTIONS RETURN THE SINE AND COSINE FUNCTIONS OF THE
; ARGUMENT VALUES.
; ^THE INPUT ARGUMENT IS IN RADIANS.
; .BREAK
; ^EXAMPLE:
; .NOFILL
; ^^
;	{20 S=SIN(X)}
;	{30 C=COS(Y)}
; \\
; .FILL
;-
;
SINE00:	MOV	#SIN,R0		;ADD OF FORTRAN SINE ROUTINE -> R0
	BR	FNSTRT
	.SBTTL	COS00 - COSINE FUNCTION
;
; COS ROUTINE
;
COS00:	MOV	#COS,R0		;ADD OF FORTRAN COSINE ROUTINE -> R0
	BR	FNSTRT

	.SBTTL	ATN00 - ARC-TANGENT FUNCTION
;+4
; .SKIP
; .X ^^ATN\\
; .X ^ARCTANGENT FUNCTION
; .HEADERLEVEL 1 <ATN
; .BREAK
; ^RETURNS THE ARCTANGENT FUNCTION OF THE ARGUMENT VALUE.
; ^THE RETURNED VALUE IS IN RADIANS.
; .BREAK
; ^EXAMPLE:
; .NOFILL
; ^^
;	{10 A=ATN(X)}
; \\
; .FILL
;-
;
; ARC-TANGENT FUNCTION
;
ATN00:	MOV	#ATAN,R0	;ADDRESS OF FORTRAN ARCTAN FUNCTION -> R0
	BR	FNSTRT

	.SBTTL	SQRT00 - SQUARE ROOT FUNCTION
;+4
; .SKIP
; .X ^^SQR\\
; .X ^SQUARE ROOT FUNCTION
; .HEADERLEVEL 1 <SQR
; .BREAK
; ^RETURNS THE SQUARE ROOT OF THE ARGUMENT VALUE.
; ^IF THE ARGUMENT VALUE IS NEGATIVE, AN ERROR IS GIVEN.
; .BREAK
; ^EXAMPLE:
; .NOFILL
; ^^
;	{20 S=SQR(X)}
; \\
; .FILL
;-
;
; SQUARE ROOT FUNCTION
;
SQRT00:	MOV	#SQRT,R0	;ADDRESS OF FORTRAN SQUARE ROOT ROUTINE -> R0
;
; START OF COMMON FORTRAN FUNCTION PROCESSING CODE
;
FNSTRT:	MOV	R1,-(SP)	;SAVE TEXT POINTER
	CLRF	-(SP)		;JUST IN CASE LOAD DOUBLE IS USED (SIN)
	STF	AC0,-(SP)	;PUT ARG ON STACK
	MOV	SP,R1		;ADDRESS OF ARG -> R1
	MOV	R1,-(SP)	;SAVE IT IN ARG LIST FOR FORTRAN
	MOV	#1,-(SP)	;FORM ARG LIST FOR FORTRAN
	MOV	SP,R5		;R5 IS ARG LIST POINTER
	JSR	PC,(R0)		;GO TO CHOSEN ROUTINE
	MOV	R1,-(SP)	;SAVE RESULT
	MOV	R0,-(SP)	;ON STACK
	LDF	(SP)+,AC0	;SO WE CAN PUT IT BACK IN AC0
	ADD	#14,SP		;CLEAN STACK
	MOV	(SP)+,R1	;RESTORE TEXT POINTER
	RTS	PC		;AND RETURN

	.SBTTL	INX - INDEX (POSITION) STRING FUNCTION
	.SBTTL	POS - POSITION (INDEX) STRING FUNCTION
;+5
; .SKIP
; .X ^^INX\\
; .X ^^POS\\
; .X ^INDEX STRING FUNCTION
; .X ^POSITION STRING FUNCTION
; .HEADERLEVEL 1 <INX . . <POS
; .BREAK
; .NOFILL
; ^FORMAT:
;	^^POS(STRING1,STRING2 [,P1] [,P2])\\
; .FILL
; ^THIS FUNCTION COMPUTES THE POSITION OF ^^STRING2\\ IN ^^STRING1\\ STARTING
; AT OPTIONAL POSITION ^P1 (^P1 ASSUMED TO BE 1 IF NOT SPECIFIED).
; ^A SECOND OPTIONAL PARAMETER ^P2 SPECIFIES THE FINAL CHARACTER POSITION.
; ^IF IT IS NOT SPECIFIED, IT IS ASSUMED TO BE THE END OF THE FIRST STRING.
; ^^INX\\ AND ^^POS\\ ARE IDENTICAL.
; .BREAK
; ^EXAMPLE:
; .NOFILL
; ^^
;	{10 A=POS("ABC","B")}
;	{20 X=POS(A1$,A2$,5,7)}
; \\
; .FILL
;-
INX00:	MOV	ENUDAT,-(SP)	;SAVE CURRENT END OF LIST POINTER
	JSR	PC,STRCOM	;GET FIRST STRING ARGUMENT
				;LEN AND ADD ON STACK
	SKIP			;NEXT CHAR
	CMPB	R2,#',		;IS IT A COMMA?
	BNE	FUN99		;IF NOT, ERROR
	JSR	PC,STRCOM	;GET NEXT STRING ARG
	CLRF	AC0		;CLEAR ACCUM IN CASE NO ARG
	SKIP			;NEXT CHAR
	CMPB	R2,#',		;MORE PARAMS?
	BEQ	1$		;IF SO, BRANCH
	CMPB	R2,#')		;IF NOT, BETTER BE CLOSE PAREN
	BNE	FUN99		;ELSE ERROR
	BR	4$		;BRANCH AROUND REST OF THIS CODE
1$:	EVAL			;GET START POSITION
	BVS	4$		;IF ')', NO MORE PARAMS
	SKIP
	CMPB	R2,#',		;NEXT CHAR COMMA?
	BNE	FUN99		;IF NOT, ERROR
	STCFI	AC0,-(SP)	;SAVE FIRST POSITION
	EVAL			;GET FINAL POSITION IN AC0
	BVC	FUN99		;IF NO ')', ERROR
	STCFI	AC0,R5		;STORE FINAL POS. IN R5
	SUB	6(SP),R5	;SUBTRACT LEN OF FIRST STRING
	BGE	5$		;IF POS OR ZERO, DON'T DO ANYTHING
	ADD	R5,6(SP)	;DECREMENT STRING LEN
5$:	LDCIF	(SP)+,AC0	;GET FIRST POS IN AC0
4$:	MOV	(SP)+,R4	;RESTORE STRING2
	MOV	(SP)+,R3	;DESCRIPTORS
	STCFI	AC0,R5		;START POS IN R5
	DEC	R5		;MAKE OFFSET
	BGE	3$		;ASSUME 1ST OR MORE
	CLR	R5
3$:	MOV	(SP)+,R0	;RETRIEVE LEN AND
	MOV	(SP)+,R2	;ADDRESS OF 1ST STRING
	MOV	R1,4(SP)	;SAVE TEXT POINTER
	MOV	R5,-(SP)	;SAVE STARTING OFFSET
	ADD	R5,R2		;ADJUST ADDRESS
	SUB	R5,R0		;AND LEN
	BLE	INX03		;IF OFFSET BEYOND LEN, RETURN 0
	TST	R4		;IF 2ND STRING NULL, POINT TO
	BEQ	INX06		;FIRST ALLOWED POSTION IN 1ST STRING
INX02:	CMP	R0,R4		;ROOM IN SOURCE TO CHECK
	BLT	INX03		;RETURN ZERO IF NOT
	INC	@SP		;KEEP RESULT COUNTER
	MOV	R4,-(SP)	;SAVE LENGTH
	MOV	R2,R1		;SET WORK REGS
	MOV	R3,R5
INX01:	CMPB	(R1)+,(R5)+	;THESE TWO MATCH
	BNE	INX04		;GO SLIDE MASK IF NOT
	DEC	@SP		;MORE TO MASK
	BNE	INX01		;BR IF NO HIT YET
	TST	(SP)+		;CLEAN - WE HAVE FOUND STRING
INX05:	LDCIF	(SP)+,AC0	;GET NUMBER AS FLOAT
	MOV	(SP)+,ENUDAT	;RESTORE OLD END OF USER STORAGE
	RTS	PC		;AND RETURN
INX03:	CLR	@SP		;SET RESULT ZERO
	BR	INX05		;AND RETURN IT
INX04:	CMPB	(SP)+,(R2)+	;CLEAN STACK - SLIDE MASK
	SOB	R0,INX02	;LOOP IF MORE CHARS IN SOUR
	BR	INX03		;ELSE ZERO RESULT HIM
INX06:	INC	(SP)		;GET BACK TO CHAR POSITION
	BR	INX05		;AND RETURN
FUN99:	STXERR			;SYNTAX ERROR IN FUNCTION
;
; STRCOM
; SUBROUTINE TO EVALUATE A SINGLE STRING ARGUMENT.
; ON ENTRY:
;	R1 POINTS TO START OF STRING ARG
;
; ON EXIT:
;	R1 POINTS TO DELIMITING CHAR
;	(SP) HAS STRING LEN
;	2(SP) HAS STRING ADD
;	ENUDAT POINTS PAST END OF STRING
;	R5 SAME AS ENUDAT
;
; OTHER REGISTERS USED:
;	POTENTIALLY ALL
;
STRCOM:
	EVALS			;EVALUATE THE STRING
	BVS	1$		;ON ERROR, GO TRAP
	MOV	R3,R5		;NOW
	ADD	R4,R5		;ROUND UP END
	INC	R5		;OF USER STORAGE
	BIC	#1,R5		;
	MOV	R5,ENUDAT	;AND UPDATE PTR
	MOV	(SP)+,R0	;POP RTN ADD
	MOV	R3,-(SP)	;STORE ADD
	MOV	R4,-(SP)	;AND LEN
	JMP	(R0)		;DO EFFECTIVE RETURN
1$:	STXERR			;REPORT ERROR

	.SBTTL	LEN00 - LENGTH OF STRING FUNCTION
;+5
; .SKIP
; .X ^^LEN\\
; .X ^LENGTH OF STRING FUNCTION
; .HEADERLEVEL 1 <LEN
; .BREAK
; ^THIS FUNCTION COMPUTES THE LENGTH OF A SINGLE STRING EXPRESSION
; ARGUMENT.
; .BREAK
; ^EXAMPLE:
; .NOFILL
; ^^
;	{30 X=LEN(A$)}
; \\
; .FILL
;-
LEN00:	EVALS			;COLLECT STRING
	BVS	FUN99		;BR IF ERROR
	SKIP
	CMP	R2,#')		;END OF FUNCTION
	BNE	FUN99		;ERROR IF NOT
	MOV	R1,2(SP)	;SAVE TEXT POINTER
	LDCIF	R4,AC0		;CONVERT TO FLOAT
	RTS	PC		;AND RETURN
	.SBTTL	VAL00 - VALUE STRING FUNCTION
;+5
; .SKIP
; .X ^^VAL\\
; .X ^VALUE OF STRING FUNCTION
; .X ^NUMERIC VALUE OF STRING
; .HEADERLEVEL 1 <VAL
; .BREAK
; ^THIS FUNCTION TAKES AN ^^ASCII\\ STRING CONTAINING A LEGAL
; NUMERIC EXPRESSION AND RETURNS A FLOATING POINT VALUE.
; .BREAK
; ^EXAMPLE:
; .NOFILL
; ^^
;	{10 A=VAL(A$)}
; \\
; .FILL
;-
;+5
; .SKIP
; .X ^^OCT\\
; .X ^OCTAL VALUE OF STRING
; .HEADERLEVEL 1 <OCT
; .BREAK
; ^THIS FUNCTION TAKES AN ^^ASCII\\ STRING CONTAINING A LEGAL
; OCTAL INTEGER REPRESENTATION AND RETURNS A FLOATING POINT VALUE.
; .BREAK
; ^EXAMPLE:
; .NOFILL
; ^^
;	{10 A=OCT("1777")}
; \\
; .FILL
;-
VAL00:	CLR	-(SP)		;SET DECIMAL FLAG
	BR	VAL01
OCB00:	MOV	#1,-(SP)	;SET OCTAL FLAG
VAL01:	EVALS			;GET ONE STRING WITH ADDRESS IN R3, LEN IN R4
	MOV	ENUDAT,R5	;R5 POINTS TO START OF STRING SCRATCH ITEM
	MOV	(SP)+,R0	;GET FLAG IN R0
	SKIP			;GET NEXT NON-BLANK CHAR AFTER ARGUMENT
	CMP	R2,#')		;SHOULD BE RIGHT PAREN.
	BNE	FUN99		;IF NOT, ERROR
	MOV	R1,2(SP)	;SAVE THE TEXT POINTER
	MOV	R3,R1		;SET STRING ADDRESS IN R1
	TST	R4		;CHECK STRING LENGTH
	BEQ	5$		;IF NULL, RETURN ZERO
7$:	CMPB	#40,(R3)+	;TRIM OFF LEADING BLANKS
	BNE	6$		;IF NON-BLANK, OK
	SOB	R4,7$		;KEEP GOING TILL AT END
	BR	5$		;EFFECTIVELY NULL STRING
6$:	DEC	R3		;READJUST R3
	ADD	R4,R3		;LET R3 POINT TO END
	MOVB	#',,(R3)+	;PUT DELIMITER AT END
	INCB	(R5)		;INCREMENT SCRATCH COUNT
	MOV	R3,-(SP)	;SAVE R3 ON STACK FOR REFERENCE
	TST	R0		;OCTAL OR DECIMAL?
	BNE	3$		;IF OCTAL, BRANCH
	MOV	R5,-(SP)	;SAVE R5
	MOV	R3,R5		;PUT R5 AT EVEN
	INC	R5		;END OF STRING
	BIC	#1,R5
	MOV	R5,ENUDAT	;SAVE END OF USER LIST
	ATOF
	BVS	8$		;ON ERROR, BRANCH
	MOV	(SP)+,ENUDAT	;GET OLD ENUDAT
	BR	4$		;GO TO COMMON FINISHING CODE
3$:	MOV	R1,R0		;SET STRING POINTER IN R0
	JSR	PC,$COTB	;DO OCTAL CONVERSION
	LDCIF	R1,AC0		;PUT RESULT IN AC0
	MOV	R0,R1		;UPDATE STRING POINTER
	DEC	R1		;BACK UP 1
4$:	SKIP			;MAKE R1 POINT AFTER NEXT NON-BLANK CHAR.
	CMP	R1,(SP)+	;ARE WE AT END OF STRING?
	BNE	1$		;IF NOT, ERROR
	BR	2$		;DO SUCCESSFUL RETURN
8$:	MOV	(SP)+,ENUDAT	;RESTORE END OF USER AREA
	TST	(SP)+		;CLEAN STACK
1$:	VALERR
5$:	CLRF	AC0		;SET ZERO FOR NULL STRING
2$:	RTS	PC
	.SBTTL	AR500 - ASCII TO RAD50 CONVERSION
;+5
; .SKIP
; .X ^^AR5\\
; .X ^ASCII TO <RAD50 CONVERSION FUNCTION
; .HEADERLEVEL 1 <AR5
; .BREAK
; ^THIS FUNCTION RETURNS A NUMERIC VALUE CORRESPONDING TO THE
; <DEC <RAD50 CONVERSION OF THE FIRST THREE CHARACTERS OF THE
; ARGUMENT STRING. ^IF LESS THAN THREE CHARACTERS ARE SUPPLIED,
; THE RESULT IS AS IF THE INPUT WERE BLANK PADDED AT THE END.
; ^ALL LEGAL <RAD50 CHARACTERS INCLUDING BLANK AND PERIOD ARE
; CONVERTED.
; .BREAK
; ^EXAMPLE:
; .NF
; ^^
; 	{100 A%=AR5("ABC")}
; 	{110 B1=AR5(A$+B$)}
; \\
; .F
;-
AR500:
	EVALS			;GET THE SOURCE STRING
	BVS	FUN99		;ON SYNTAX ERROR, BRANCH
	SKIP			;CHECK FINAL CHARACTER
	CMPB	R2,#')		;FOR CLOSE PAREN
	BNE	FUN99		;IF NOT, ERROR
	MOV	R1,2(SP)	;SAVE TEXT PTR
	MOV	R3,R0		;COPY START OF SOURCE STRING -> R0
	CLR	R1		;ALL CHARS TO BE CONVERTED
	JSR	PC,$CAT5	;GO TO SUBROUTINE
	LDCIF	R1,AC0		;RESULT -> AC0
	RTS	PC		;AND THAT'S ALL THERE IS TO IT
	.SBTTL	ASC00 - NUMERIC VALUE OF ASCII CODE
;+5
; .SKIP
; .X ^^ASC\\
; .X ^ASCII VALUE OF CHARACTER
; .HEADERLEVEL 1 <ASC
; .BREAK
; ^THIS FUNCTION RETURNS THE NUMERIC VALUE OF THE FIRST ^^ASCII\\ CHARACTER
; IN THE STRING ARGUMENT.
; ^FOR A NULL STRING, 0 IS RETURNED.
; .BREAK
; ^EXAMPLE:
; .NOFILL
; ^^
;	{10 I=ASC("A")}
; \\
; .FILL
;-
ASC00:	EVALS			;GET THE STRING
	BVS	FUN99		;BR ON ERROR
	SKIP			;GET NEXT CHAR
	CMP	R2,#')		;IS IT CLOSE PAREN
	BNE	FUN99		;IF NOT, ERROR
	MOV	R1,2(SP)	;SAVE TEXT POINTER
	CLRF	AC0		;SET ZERO
	TST	R4		;IN CASE NULL STRING
	BEQ	1$
	MOVB	(R3),R4		;PUT CHAR IN R4
	LDCIF	R4,AC0		;CONVERT IT
1$:	RTS	PC		;AND RETURN
	.SBTTL	NRC00 - NUMBER OF RECORDS IN A FILE
;+4
; .SKIP
; .X ^^NRC\\
; .X ^RECORD COUNT FUNCTION
; .X ^NUMBER OF RECORDS FUNCTION
; .HEADERLEVEL 1 <NRC
; .BREAK
; ^THIS FUNCTION CALCULATES THE NUMBER OF RECORDS IN THE
; FILE NUMBER WHICH IS SPECIFIED IN THE ARGUMENT.
; ^THE FILE MUST BE A FIXED LENGTH RECORD TYPE.
; ^A -1 RETURNED INDICATES A NON-EXISTENT ^^FDB\\.
; ^A -2 RETURNED INDICATES VARIABLE LENGTH RECORDS.
; .BREAK
; ^EXAMPLE:
; .NOFILL
; ^^
;	{10 A=NRC(4)}
; \\
; .FILL
;-
F.ONE:	.FLT2	1.
F.512:	.FLT2	512.
NRC00:	EVAL			;GET FILE NUMBER IN AC0
	BVS	1$		;NEED CLOSE PAREN
	STXERR			;ELSE ERROR
1$:	STCFI	AC0,R4		;FILE NUM IN R4
	DEC	R4
	MOV	R1,2(SP)	;SAVE TEXT POINTER
	CMP	#255.,R4	;IS IT LEGAL
	BHIS	2$		;IF SO, BRANCH
	FNMERR
2$:	MOV	#017400,R0	;MASK OFF IRRELEVANT BITS
	CLRF	AC0		;CLEAR FOR LATER (IN CASE ERROR)
	JSR	PC,SRCHFL	;GO FIND FDB
	BEQ	3$		;IF SEARCH FAILED, ERROR
	ADD	#26,R3		;MAKE R3 POINT TO FDB
	BITB	#R.FIX,F.RTYP(R3) ;FIXED LEN RECORDS?
	BEQ	4$		;IF NOT, ERROR
	SETL			;GET LONG INTEGER
	LDCLF	F.EFBK(R3),AC0	;FOR # OF BLOCKS IN AC0
	SUBF	F.ONE,AC0	;DECREMENT
	SETI			;BACK TO SHORT INTEGERS
	LDCIF	F.RSIZ(R3),AC1	;GET RECORD SIZE
	DIVF	AC1,AC0
	MULF	F.512,AC0
	LDCIF	F.FFBY(R3),AC3
	DIVF	AC1,AC3
	ADDF	AC3,AC0
	BR	5$
4$:	SUBF	F.ONE,AC0	;SET UP ERROR CODES
3$:	SUBF	F.ONE,AC0
5$:	RTS	PC
;+4
; .SL
; .X <ERR
; .X <ERL
; .X <FCS
; .X ^ERROR CODE FUNCTIONS
; .HEADERLEVEL 1 <ERR . . <ERL . . <FCS
; .BR
; ^THESE FUNCTIONS RETURN RESPECTIVELY: THE NUMBER OF THE LAST ERROR,
; THE LINE NUMBER OF THE LAST ERROR, AND THE <FCS ERROR CODE (NEGATIVE)
; FOR THE LAST <FILES-11 RELATED ERROR.
; ^AN ARGUMENT FOR THE FUNCTION MUST BE INCLUDED ATLHOUGH IT WILL
; USUALLY BE ZERO.
; ^IF A NON-ZERO ARGUMENT IS USED, IT WILL BE TREATED AS A WORD
; OFFSET FROM THE INTERPRETER LOCATION CONTAINING THE NORMAL
; INFORMATION FOR THAT FUNCTION.
; ^THUS A NON-ZERO OFFSET SHOULD ONLY BE USED IN CONJUNCTION WITH
; A MAP AND ASSEMBLER LISTING.
; .BR
; ^EXAMPLE:
; .NF
; ^^
; 	{100 A=ERR(0)}
; 	{110 B=FCS(0)}
; 	{120 CON ERL(1)}
; \\
; .F
;-
ERR00:	MOV	#PARLST+P.ERCD,-(SP)	;PUT ADDRESS OF
	BR	ERR01			;REQUIRED PARAM
ERL00:	MOV	#PARLST+P.LINE,-(SP)	;ON STACK
	BR	ERR01
FCS00:	MOV	#PARLST+P.FCS,-(SP)
ERR01:	EVAL			;EVALUATE ARGUMENT
	BVS	1$		;WE NEED CLOSE PAREN
	STXERR			;ELSE ERROR
1$:	STCFI	AC0,R0		;STORE RESULT IN R0
	ASL	R0		;MAKE WORD OFFSET INTO BYTE OFFSET
	ADD	(SP)+,R0	;ADD IN REQ'D PARAM
	CLRF	AC0		;MAKE RESULT ZERO, IN CASE BOGUS ADDRESS
	CMP	R0,ENDUSR	;PAST END OF IMPURE INTERPRETER?
	BHI	2$		;IF SO, BRANCH (DON'T CAUSE MEMORY PROTECT ERR)
	LDCIF	(R0),AC0		;STORE AWAY RESULT
2$:	MOV	R1,2(SP)	;STORE AWAY TEXT POINTER
	RTS	PC
;+4
; .SL
; .X <COR
; .X ^FREE CORE FUNCTION
; .HEADERLEVEL 1 <COR
; .BR
; ^THIS FUNCTION RETURNS THE FREE CORE (IN BYTES) MINUS THE VALUE
; OF THE ARGUMENT.
; .BR
; ^EXAMPLE:
; .NF
; ^^
; 	{100 A=COR(255)}
; \\
; .F
;-
COR00:	EVAL			;ARG VALUE -> AC0
	BVS	1$		;NO CLOSE PAREN IS ERROR
	STXERR
1$:	SETL			;AND FPP ALSO
	MOV	STGOSB,-(SP)	;END OF CORE VALUE -> STACK
	CLR	-(SP)		;SET UP STACK FOR DOUBLE PRECISION
	LDCLF	(SP),AC1	;AND NOW -> AC1
	MOV	ENUDAT,2(SP)	;NOW PUT IN END OF ACTUAL USER DATA
	LDCLF	(SP),AC2	;AND -> AC2
	SUBF	AC2,AC1		;ACTUAL FREE CORE -> AC1
	CMP	(SP)+,(SP)+	;CLEAN UP STACK
	SUBF	AC0,AC1		;NOW ADJUSTED VALUE -> AC1
	MOV	R1,2(SP)	;SAVE TEXT POINTER
	LDF	AC1,AC0		;PUT ANSWER BACK -> AC0
	SETI			;BACK TO STANDARD MODE
	RTS	PC

	.SBTTL	CHR$ - ASCII CODE OF NUMERIC VALUE
;+5
; .SKIP
; .X ^^CHR$\\
; .X ^CHARACTER FROM ^ASCII VALUE FUNCTION
; .HEADERLEVEL 1 <CHR$
; .BREAK
; ^ROUTINE TO RETURN A ONE CHARACTER STRING CORRESPONDING TO A NUMERIC
; ^^ASCII\\ VALUE.
; .BREAK
; ^EXAMPLE:
; .NOFILL
; ^^
;	{10 LET A$=CHR$(65)}
; \\
; .FILL
;-
CHR00:	EVAL			;GET NUMBER
	BVC	SBS99		;MUST HAVE CLOSE PAREN
	STCFI	AC0,R4		;PUT INTEGER RESULT IN R4
	MOV	ENUDAT,R3	;START STRING SCRATCH ELEMENT
	MOV	#160001,(R3)+	;PUT IN SCRATCH HEADER
	MOVB	R4,(R3)		;PUT VALUE AWAY
	MOV	#1,R4		;LEN IS 1
	RTS	PC

	.SBTTL	SBS00 - SUBSTRING FUNCTION
	.SBTTL	SEG00 - SUBSTRING FUNCTION
;+5
; .SKIP
; .X ^^SEG$\\
; .X ^^SBS$\\
; .X ^^RIGHT\\
; .X ^^LEFT\\
; .X <MID
; .X ^SUBSTRING FUNCTIONS
; .HEADERLEVEL 1 <SEG$ <SBS$ <RIGHT <LEFT <MID
; .BREAK
; .NOFILL
; ^FORMAT:
;	^^SEG$(STRING,A[,B])
;	SBS$(STRING,A[,B])
;	MID(STRING,A,[B])
;	RIGHT(STRING,N)
;	LEFT(STRING,N)\\
; .FILL
; ^WHERE '^^STRING\\' IS A LEGAL STRING EXPRESSION AND ^A IS THE FIRST
; CHARACTER IN THE STRING TO BE SELECTED. ^IN ^^SEG$\\, ^B IS THE LAST
; CHARACTER TO BE INCLUDED IN THE OUTPUT STRING; IN ^^SBS$\\, IT IS THE
; NUMBER OF CHARACTERS TO INCLUDE. ^IF NOT SPECIFIED IN EITHER CASE
; ALL CHARACTERS TO THE END OF THE STRING ARE INCLUDED.
; ^A NULL STRING IS RETURNED WHEN THE FIRST CHARACTER POSITION IS
; NOT WITHIN THE SOURCE STRING.
; ^WHEN THE ENDING POSITION OR LENGTH PLACES ONE BEYOND THE END OF
; THE SOURCE STRING, ALL CHARACTERS TO THE END ARE INCLUDED WITH NO
; BLANK FILL.
; ^IF THE FIRST POSITION IS AFTER THE FINAL, A NULL STRING IS RETURNED.
; ^IF ^A IS LESS THAN 1 A NULL STRING IS RETURNED.
; ^IF ^B PLACES THE FINAL CHARACTER POSITION PAST THE END OF THE STRING,
; IT IS AS THOUGH THE ENDING POSITION WAS SPECIFIED.
; .SKIP
; <RIGHT <LEFT AND <MID ARE PROVIDED FOR COMPATIBILITY WITH OTHER VERSIONS
; OF <BASIC (IN PARTICULAR <RSTS <BASIC-PLUS).
; ^NOTE THAT THE NAMES ARE NOT FOLLOWED BY '$' EVEN THOUGH THE RESULTS
; ARE STRING VALUES.
; ^THESE FUNCTIONS RETURN THE RIGHT-MOST OR LEFT MOST <N CHARACTERS
; OF THE STRING RESPECTIVELY. <MID RETURNS <B CHARACTERS, STARTING AT
; POSITION <A, AND IS THUS A SYNONYM FOR <SBS$. ^NOTE THAT SOME <BASIC
; <RIGHT FUNCTIONS RETURN THE <N THRU END CHARACTERS OF THE STRING. ^IF
; PROGRAMS EXPECT THIS ACTION, THE <RIGHT(N) FUNCTION SHOULD BE REPLACED
; BY A <SBS$(N) FUNCTION.
; .BREAK
; ^EXAMPLE:
; .NOFILL
; ^^
;	{10 A$=SEG$(B$,1,5)}
;	{30 X$=SBS$(Y$,6)}
; \\
; .FILL
;-
; ON EXIT R3 CONTAINS THE ADDRESS AND R4 CONTAINS THE LENGTH
; OF THE RESULTING STRING.
;
;
SEG00:	MOV	#2,-(SP)	;SET SEGMENT FLAG
	BR	SBS06
LEFT00:	MOV	#4,-(SP)	;SET LEFT FLAG
	BR	SBS06
RIGHT0:	MOV	#6,-(SP)	;SET RIGHT FLAG
	BR	SBS06
SBS00:	CLR	-(SP)		;INDICATE SUBSTRING
SBS06:
	MOV	ENUDAT,-(SP)	;SAVE OLD END OF USER DATA
	JSR	PC,STRCOM	;GO RETRIEVE STRING ARGUMENT ON STACK
	SKIP			;NEXT CHAR
	CMP	R2,#',		;SEPARATOR?
	BNE	SBS99		;ERROR IF NONE
	CLR	-(SP)		;SET 2/3 ARG FLAG
	EVAL			;GET STRING START
	BVS	SBS01		;BR IF ")" FOUND
	INC	@SP		;SET FOR 3 ARGS
SBS01:	STCFI	AC0,R0		;GET INTEGER VALUE
	DEC	R0		;ADJUST IT
	MOV	10(SP),R2	;GET FUNCTION FLAG -> R2
	JMP	@2$(R2)		;USE IT AS OFFSET INTO JUMP TABLE
2$:	.WORD	1$	;SBS$ (OR MID)
	.WORD	4$	;SEG$
	.WORD	5$	;LEFT
	.WORD	6$	;RIGHT
4$:	MOV	R0,10(SP)	;SAVE THE STARTING NUM -1
1$:	CMP	R0,2(SP)	;CHECK AGAINST SOURCE LEN
	BLO	SBS04		;BR IF WITHIN STRING
	CLR	2(SP)		;FORCE NULL STRING
	BR	SBS02		;CONTINUE
5$:
	INC	R0		;BACK TO COUNT (NOT OFFSET)
	CMP	R0,2(SP)	;CHECK REQ'D LEN
	BHIS	51$		;IF TOO MUCH, GIVE WHAT WE HAVE
	MOV	R0,2(SP)	;IF LESS, MODIFY
51$:	TST	(SP)		;MUST BE 2 ARGS ONLY
	BNE	SBS99		;IF NOT, ERROR
	BR	SBS02
6$:
	INC	R0		;BACK TO COUNT (NOT OFFSET)
	CMP	R0,2(SP)	;CHECK OUT NEEDED LEN
	BHIS	51$		;IF TOO MUCH, GIVE WHAT HAVE
	MOV	2(SP),R2	;CALCULATE
	ADD	4(SP),R2	;ADD OF END -> R2
	SUB	R0,R2		;R2 HAS NEW ADDRESS
	MOV	R2,4(SP)	;STORE IT
	MOV	R0,2(SP)	;AND NEW LEN
	BR	51$		;AND FINISH
SBS04:	ADD	R0,4(SP)	;ADJUST DATA ADDRESS
	SUB	R0,2(SP)	;AND LENGTH
SBS02:	MOV	(SP)+,R0	;ANOTHER ARG EXIST
	BEQ	SBS05		;BR IF 2 ARG CALL
	SKIP			;MUST HAVE "," SEPERATOR
	CMPB	R2,#',
	BNE	SBS99		;ERROR IF NOT
	EVAL			;GET 3RD ARG
	BVC	SBS99		;MUST HAVE PAREN
	STCFI	AC0,R0		;GET INTEGER
	SUB	6(SP),R0	;SUBTRACT INITIAL POS-1 IF SEG$
	BGT	SBS05		;BR IF POSSIBLY VALID
	CLR	@SP		;FORCE NULL
SBS05:	MOV	(SP)+,R4	;GET LENGTH
	MOV	(SP)+,R3	;GET DATA ADDRESS
	MOV	(SP)+,ENUDAT	;RESTORE LIST POINTER
	TST	(SP)+		;POP SEG$-SBS$ FLAG
	TST	R0		;ANY LENGTH
	BEQ	SBS03		;SKIP IF NOT
	CMP	R0,R4		;CHECK IF WHOLE STRING NEEDED
	BHI	SBS03		;BR IF SO
	MOV	R0,R4		;ELSE SET FOR PARTIAL STRING
SBS03:	RTS	PC		;RETURN STRING
SBS99:	SBSERR			;FATAL ERROR

	.SBTTL	PIEC0 - SUBSTRING BY DELIMITER STRING FUNCTION
;+5
; .SKIP
; .X ^^PIECE$\\
; .X ^PIECE OF STRING BY DELIMITER
; .HEADERLEVEL 1 <PIECE$
; .BREAK
; .NF
; ^FORMAT:
; 	^^PIECE$(STRING1,STRING2,N1 [,N2])\\
; .F
; <PIECE$ INSPECTS A SPECIFIED STRING (<STRING1) AND TAKES
; FROM IT THAT SUBSTRING WHICH LIES BETWEEN TWO SPECIFIED
; OCCURRENCES OF A PARTICULAR DIVIDING STRING (<STRING2).
; ^THE RESULTING SUBSTRING BEGINS IMMEDIATELY AFTER THE <N1
; MINUS ONE OCCURRENCE OF THE DIVIDING STRING AND ENDS
; IMMEDIATELY BEFORE THE ^N2ND OCCURRENCE (OR ^N1ST IF ^N2
; IS UNSPECIFIED).
; .BREAK
; ^EXAMPLE:
; .NF
; ^^
; 	{110 M$=PIECE$("12/1/77","/",1) :! EXTRACT MONTH FROM STRING}
; 	{120 A$=PIECE$("12/1/77","/",1,2) :! EXTRACT MONTH AND DAY}
; \\
; .F
;-
PIECE0:
	MOV	ENUDAT,-(SP)	;SAVE OLD END OF USER DATA
	CLR	-(SP)		;SAVE SLOT FOR R1
	JSR	PC,STRCOM	;GET SOURCE STRING
	SKIP
	CMPB	R2,#',		;NEXT CHAR COMMA?
	BNE	13$		;IF NOT, ERROR
	JSR	PC,STRCOM	;GET DELIMITING STRING
	CLRF	AC0		;CLEAR ACCUM FOR N1
	SKIP			;CHECK ON COMMA
	CMPB	R2,#',		;
	BEQ	1$		;IF THERE, GO EVAL PARAM
	CMPB	R2,#')		;ELSE MUST BE ')'
	BNE	13$		;IF NOT, SYNTAX ERROR
	ADDF	#1,AC0		;DEFAULT N1 TO 1
	BR	2$
1$:	EVAL			;GET N1 -> AC0
	BVC	3$		;IF NO ')', BRANCH
2$:	STCFI	AC0,-(SP)	;STORE N1
	CLRF	AC0		;SET ZERO FOR N2
	BR	4$
3$:	STCFI	AC0,-(SP)	;N1 ON STACK
	SKIP			;MUST HAVE
	CMPB	R2,#',		;COMMA DELIM
	BNE	13$		;IF NOT, ERROR
	EVAL			;GET N2 -> AC0
	BVC	13$		;IF NO ')', ERROR
; AT THIS POINT STACK AS FOLLOWS:
;	  (SP) N1
;	 2(SP) LEN OF STRING2
;	 4(SP) ADD OF STRING2
;	 6(SP) LEN OF STRING1
;	10(SP) ADD OF STRING1
;	12(SP) SLOT FOR R1
;	14(SP) OLD ENUDAT
;	16(SP) SUBROUTINE RETURN ADDRESS
; IN ADDITION AC0 HAS N2
4$:	MOV	R1,12(SP)	;FREE UP R1
	DEC	(SP)		;N1-1 ON STACK
	LDCIF	(SP)+,AC1	;NOW -> AC1
	LDCIF	(SP)+,AC2	;LEN OF STRING2 -> AC2
	LDCIF	(SP)+,AC3	;ADD OF STRING2 -> AC3
	MOV	(SP)+,R0	;LEN OF STRING1 -> R0
	MOV	(SP)+,R1	;ADD OF STRING1 -> R1
	TST	R0		;CHECK LEN OF SOURCE STRING
	BLE	12$		;IF ZERO OR LESS, RETURN NULL (BRANCH)
	SUBF	AC1,AC0		;N2-N1+1 -> AC0
	CFCC
	BGT	41$		;IF POS, BRANCH
	LDCIF	#1,AC0		;MAKE IT 1 BY DEFAULT
41$:	TSTF	AC1		;CHECK ITERATION COUNT
	CFCC
	BGT	5$		;IF POS, GO FIND MATCH
	CLR	-(SP)		;IF DOWN TO ZERO, RECORD POSITION
	BR	7$		;ON STACK AND SKIP SOME CODE
5$:	JSR	PC,STCM		;OTHERWISE FIND MATCH
	BNE	12$		;IF NO MATCH, RETURN NULL STRING
	SUBF	#1,AC1		;DECREMENT LOOP COUNTER
	CFCC
	BLE	6$		;IF ZERO, THIS IS START
	INC	R1		;PUSH STRING DESCRIPTORS PAST
	DEC	R0		;CURRENT CHAR
	BR	5$		;ELSE GO AROUND AGAIN
13$:	STXERR
6$:	STCFI	AC2,-(SP)	;LEN OF DELIM STRING + START OF
7$:	ADD	R1,(SP)		;ITS OCCURRENCE = START OF RESULT
8$:	INC	R1		;PUSH SOURCE STRING
	DEC	R0		;UP ONE CHAR
	JSR	PC,STCM		;GO LOOK FOR NEXT MATCH
	BNE	10$		;IF NONE, RETURN REST OF SOURCE
	SUBF	#1,AC0		;DECREMENT LOOP COUNTER
	CFCC
	BNE	8$		;IF NOT ZERO, LOOP
9$:	MOV	R1,R4		;R4 HAS ADD OF 1ST CHAR PAST END
				;OF DELIMITED STRING (RESULT)
	MOV	(SP)+,R3	;R3 HAS START ADDRESS
	SUB	R3,R4		;NOW R4 HAS LEN OF DELIMITED STRING
	BR	11$		;GO TO FINISH UP CODE
10$:	ADD	R0,R1		;R1 PTS TO END OF SOURCE STRING
	BR	9$
11$:	MOV	(SP)+,R1	;RESTORE TEXT PTR
	MOV	(SP)+,ENUDAT	;AND OLD END OF USER DATA
	RTS	PC
12$:	CLR	R4		;SET NULL STRING
	BR	11$
;
; SUBROUTINE TO SLIDE STRING2 ALONG STRING1
; LOOKING FOR A MATCH
; ON ENTRY:
; 	AC2 LEN OF STRING2
;	AC3 ADD OF STRING2
;	R0  LEN OF STRING1
;	R1  ADD OF STRING1
;
; ON EXIT:
;	R0 HAS REMAINING LEN OF STRING1
;	R1 HAS ADDRESS OF MATCH START
;	'Z' SET IF MATCH, CLEAR IF NOT
; OTHER REGISTERS USED: ALL
;
STCM:
	MOV	R0,R5		;COPY LEN OF STRING1 TO R5
	ADD	R1,R0		;NOW R0 PTS PAST END OF STRING1
	STCFI	AC2,R4		;LEN OF DELIMITER STRING -> R4
	SUB	R4,R5		;R5 NOW HAS # OF
	INC	R5		;ITERATIONS FOR COMPARE
	BEQ	2$		;IF ZERO TRIES, UNSUCCESSFUL
	DEC	R1		;BACK UP FOR INC WHICH FOLLOWS
1$:	INC	R1		;MOVE UP SOURCE ADDRESS
	MOV	R1,R2		;COPY IT TO R2
	STCFI	AC2,R4		;GET LEN OF COMPARE -> R4
	STCFI	AC3,R3		;AND ADDRESS OF DELIMITING STRING -> R3
	JSR	PC,STRCMP	;DO ACTUAL COMPARE
	BEQ	3$		;ON SUCCESS, BRANCH
	SOB	R5,1$		;KEEP GOING TILL SUCCESS OR FINISH
2$:	CLZ			;INDICATE FAILURE
	SUB	R1,R0		;MAKE SURE R0 IS PROPER LEN
	RTS	PC
3$:	SUB	R1,R0		;CALCULATE REMAINING LEN -> R0
	SEZ			;INDICATE SUCCESS
	RTS	PC
	.SBTTL	FCHR00 - NUMERIC TO CHARACTER STRING
;+5
; .SKIP
; .X ^^STR$\\
; .X ^NUMERIC TO CHARACTER STRING
; .HEADERLEVEL 1 <STR$
; .BREAK
; ^NUMERIC TO CHARACTER STRING CONVERSION. (^NO LEADING OR TRAILING BLANKS.)
; ^THE ^ASCII STRING REPRESENTS THE VALUE OF THE ARGUMENT.
; .NOFILL
; ^FORMAT:
;	^^STR$(X)\\
; .FILL
; ^WHERE '^X' IS ANY LEGAL NUMERIC EXPRESSION.
; .BREAK
; ^EXAMPLE:
; .NOFILL
; ^^
;	{30 A$=STR$(EXP(X)+1.4)}
; \\
; .FILL
;-
FCHR00:	EVAL			;GET NUMBER
	BVC	SBS99		;MUST HAVE PAREN
	MOV	R1,-(SP)	;SAVE TEXT POINTER
	JSR	PC,FTOA00	;CONVERT TO STRING
	MOV	ENUDAT,R5	;POINT TO FREE SPACE
	MOV	R5,R3		;GET RESULT ADDRESS
	MOV	#160000,(R3)+	;FIRST PUT IN HEADER
	CLR	R4		;LENGTH COUNTER
	MOV	SP,R0		;RESULT FROM FTOA IS ON STACK
FCHR01:	MOVB	(R0)+,(R3)+	;PASS BYTE
	BEQ	FCHR02		;BR IF DONE
	INC	R4		;ADJUST LENGTH
	INCB	(R5)		;AND SCRATCH HEADER
	BR	FCHR01		;LOOP
FCHR02:	ADD	#24,SP		;CLEAN STACK
	DEC	R3		;GO BACK TO TRIM TRAILING BLANKS
1$:	DEC	R4		;DEC STRING LENGTH
	CMPB	#40,-(R3)	;SPACE?
	BEQ	1$		;IF SO KEEP GOING BACK
	INC	R4		;ADJUST FOR LAST NON-BLANK CHAR
	MOV	R5,R3		;SET STRING ADDRESS
	ADD	#2,R3		;IN R3
2$:	CMPB	(R3)+,#40	;BLANK?
	BNE	3$		;IF NOT, BRANCH
	SOB	R4,2$		;IF SO, GO DO IT AGAIN
3$:	DEC	R3		;RE-ADJUST R3
	MOV	(SP)+,R1	;RESTORE TEXT POINTER
	RTS	PC		;AND RETURN
;
	.SBTTL	TRM00 - TRAILING BLANK TRIM FUNCTION
	.SBTTL	LTR00 - LEADING BLANK TRIM FUNCTION
;+5
; .SKIP
; .X ^^TRM$\\
; .X ^^LTR$\\
; .X ^BLANK TRIM FUNCTIONS
; .HEADERLEVEL 1 <LTR$ <TRM$
; .BREAK
; ^LEADING AND TRAILING BLANK TRIM FUNCTIONS.
; ^THE RESULTING STRING IS THE ARGUMENT STRING WITHOUT LEADING BLANKS
; FOR ^^LTR$\\ OR WITHOUT TRAILING BLANKS FOR ^^TRM$\\.
; .BREAK
; ^EXAMPLE:
; .NOFILL
; ^^
;	{30 A$=LTR$(A$)}
;	{40 B$=TRM$(C$)}
; \\
; .FILL
;-
LTR00:	MOV	#1,-(SP)	;SET FLAG FOR LEADING TRIM
	BR	TRM01
TRM00:	CLR	-(SP)		;SET FLAG FOR TRAILING TRIM
TRM01:	EVALS			;EVALUATE THE STRING
3$:	SKIP			;GET NEXT CHARACTER
	CMPB	#'),R2		;IS IT ')'
	BEQ	1$
	STXERR			;ELSE SYNTAX ERROR
1$:	TST	(SP)+		;POP FLAG
	BNE	11$		;IF NON-ZERO, LEADING TRIM
	MOV	R3,-(SP)	;SAVE STRING POINTER
	ADD	R4,R3		;END OF STRING IN R3
4$:	CMPB	-(R3),#40	;BLANK?
	BNE	5$		;IF NOT, BRANCH
	SOB	R4,4$		;KEEP TRYING
5$:	MOV	(SP)+,R3	;GET BACK STRING POINTER
	RTS	PC
11$:	CMPB	(R3)+,#40	;IS CHAR A BLANK?
	BNE	14$		;IF NOT, BREAK OUT OF LOOP
	SOB	R4,11$		;KEEP GOING TILL NON-BLANK OR ZERO COUNT
14$:	DEC	R3		;BACK UP TO FIRST NON-BLANK CHAR
	RTS	PC
	.SBTTL	OCT$ - NUMERIC TO UNSIGNED OCTAL
	.SBTTL	OCS$ - NUMERIC TO SIGNED OCTAL
;+5
; .SKIP
; .X ^^OCT$\\
; .X ^^OCS$\\
; .X ^OCTAL TO STRING FUNCTIONS
; .HEADERLEVEL 1 <OCT$ <OCS$
; .BREAK
; ^A SINGLE NUMERIC ARGUMENT IS CONVERTED TO ^^ASCII\\ REPRESENTATION
; OF AN OCTAL INTEGER.
; ^THE NUMERIC EXPRESSION IS EVALUATED AND TRUNCATED TO AN INTEGER
; PRIOR TO CONVERSION.
; ^^OCT$\\ PRODUCES AN UNSIGNED STRING, WHILE ^^OCS$\\ PRODUCES A
; SIGNED STRING.
; ^MAGNITUDES ARE LIMITED TO THOSE REPRESENTABLE IN ONE ^^PDP-11\\ WORD.
; .BREAK
; ^EXAMPLE:
; .NOFILL
; ^^
;	{40 PRINT OCS$(-53)}
;	{50 PRINT OCT$(I*16)}
; \\
; .FILL
;-
OCS00:	MOV	#1,-(SP)	;SET SIGNED FLAG
	BR	OCT01
OCT00:	CLR	-(SP)		;INDICATE UNSIGNED
OCT01:	EVAL			;GET THE NUMBER IN AC0
	BVS	3$		;MUST HAVE ")"
	STXERR			;IF NOT, ERROR
3$:	MOV	(SP)+,R4	;FLAG IN R4
	MOV	R1,-(SP)	;SAVE TEXT POINTER
	MOV	ENUDAT,R0	;SET UP STRING SCRATCH ITEM
	MOV	#160000,(R0)+	;HEADER
	MOV	R0,R3		;START OF STRING IN R3
	STCFI	AC0,R1		;PUT NUMBER IN R1
	CLR	R2		;NO LEADING ZEROES
	TST	R4		;SIGNED?
	BNE	1$		;BRANCH IF SO
	JSR	PC,$CBOMG
	BR	2$
1$:	JSR	PC,$CBOSG
2$:	MOV	R0,R4		;END OF STRING IN R4
	SUB	R3,R4		;NOW LEN IN R4
	MOVB	R4,@ENUDAT	;STORE IN HEADER
	MOV	(SP)+,R1	;RESTORE TEXT POINTER
	RTS	PC

	.SBTTL	R5A00 - RAD50 TO ASCII CONVERSION
;+5
; .SKIP
; .X <R5A$
; .X <RAD50 TO <ASCII CONVERSION FUNCTION
; .HEADERLEVEL 1 <R5A$
; .B
; ^THE <RAD50 SOURCE VALUE (VALUE RANGE OF ONE INTEGER WORD) IS
; CONVERTED TO A 3 CHARACTER STRING.
; .B
; ^EXAMPLE:
; .NF
; ^^
; 	{110 A$=R5A$(A)}
;	{120 B$=R5A$(X%)}
; \\
; .F
;-
R5A00:
	EVAL			;GET NUMBER TO BE CONVERTED
	BVS	1$		;MUST END WITH CLOSE PAREN
	STXERR			;ELSE SYNTAX ERROR
1$:	MOV	R1,-(SP)	;SAVE TEXT PTR
	MOV	#4,R0		;CHECK FOR 4 BYTES
	TSTOK			;ENUDAT -> R5
	MOV	#160003,(R5)+	;PUT IN DUMMY HEADER
	MOV	R5,R0		;START FOR CONVERSION -> R0
	STCFI	AC0,R1		;NUMBER -> R1
	JSR	PC,$C5TA	;DO CONVERSION
	SUB	R5,R0		;R0 HAS ACTUAL COUNT
	MOV	R0,R4		;NOW -> R4 WHERE WE EXPECT IT
	MOVB	R4,@ENUDAT	;STICK COUNT IN DUMMY HEADER
	MOV	R5,R3		;START OF STRING -> R3
	MOV	(SP)+,R1	;RESTORE TEXT PTR
	RTS	PC

	.SBTTL	DAT00 - DATE FUNCTION
	.SBTTL	TIM00 - TIME FUNCTION
;+4
; .SKIP
; .X ^^DAT$\\
; .X ^DATE FUNCTION
; .HEADERLEVEL 1 <DAT$
; .BREAK
; ^AN 8 CHARACTER STRING IS RETURNED CONTAINING THE DATE
; IN THE FORM ^^MO/DA/YR\\.
; IF THE ARGUMENT IS ABSENT OR A SINGLE CHARACTER ZERO, THE SYSTEM DATE (TODAY'S
; DATE HOPEFULLY!) IS RETURNED. ^IF THE ARGUMENT IS A POSITIVE VALUE,
; THE NUMBER IS INTERPRETED AS THE DAY OF THE CENTURY, AND A
; CORRESPONDING DATE STRING IS RETURNED. ^THE POSITIVE ARGUMENT
; IS INTERPRETED MODULO 36524 (THE NUMBER OF DAYS IN A CENTURY).
; ^IF THE ARGUMENT IS A ZERO OR NEGATIVE VALUE (OTHER THAN A SINGLE
; CHARACTER '0'), THEN A NULL STRING IS RETURNED.
; .BREAK
; ^EXAMPLE:
; .NOFILL
; ^^
;	{50 A$=DAT$(0) : ! RETURN SYSTEM DATE}
; 	{60 PRINT DAT$(12752)}
;	{70 A$=DAT$()  : ! RETURN SYSTEM DATE}
; \\
; .FILL
;-
;+4
; .SKIP
; .X ^^DDAT$\\
; .X <DEC STANDARD DATE FUNCTION
; .HEADERLEVEL 1 <DDAT$
; .BREAK
; ^THIS FUNCTION RETURNS A STRING CONTAINING THE <DEC
; STANDARD DATE IN THE FORM: <DD-MMM-YY.
; ^THE STRING MAY BE EITHER 8 OR 9 CHARS DEPENDING ON THE
; NUMBER OF DIGITS IN THE DAY.
; ^THE ARGUMENT IS INTERPRETED IN THE SAME WAY AS IN THE
; <DAT$ FUNCTION.
; .BREAK
; ^EXAMPLE:
; .NF
; ^^
; 	{40 A$=DDAT$(0)}
; \\
; .F
;-
;+4
; .SKIP
; .X ^^TIM$\\
; .X ^TIME FUNCTION
; .HEADERLEVEL 1 <TIM$
; .BREAK
; ^RETURNS TIME IN AN 8 CHARACTER STRING IN THE FORM ^^HR:MN:SC\\.
; ^IF THE ARGUMENT IS ABSENT OR A SINGLE CHARACTER ZERO, THE SYSTEM
; TIME IS RETURNED.
; ^OTHERWISE, THE ARGUMENT IS EVALUATED. ^IF NEGATIVE, A NULL
; STRING IS RETURNED; IF ZERO OR POSITIVE, THE NUMBER IS INTERPRETED
; AS THE NUMBER OF SECONDS SINCE MIDNIGHT AND THE CORRESPONDING
; TIME IS RETURNED AS A STRING. ^THE NUMBER IS INTERPRETED MODULO
; ONE DAY WORTH OF SECONDS.
; .BREAK
; ^EXAMPLE:
; .NOFILL
; ^^
;	{30 A$=TIM$(0)}
; 	{40 A$=TIM$()  : !RETURN SYSTEM TIME}
; 	{50 A$=TIM$(A-B) : ! RETURN TIME OF DAY CORRESPONDING TO}
;			  ! A-B SECONDS SINCE MIDNIGHT
; \\
; .FILL
;-
;
; DATE AND TIME FUNCTIONS.
; EACH RETURNS AN 8 CHAR STRING ADDRESS IN R3 AND LENGTH IN R4 (8.)
; DATE IS IN FORM: MO/DA/YR.
; TIME IS IN FORM: HR:MI:SC
;
; USE: A$=DAT$(0) OR A$=TIM$(0).
; WHERE 0 IS A DUMMY ARGUMENT.
;
; DEFINE ERROR TEMPORARILY AS SAME AS SUBSTRING FUNCTION
TBTIM:	.ASCIZ	/:/
	.WORD	TIMBUF+G.TIHR
	.WORD	TIMBUF+G.TIMI
	.WORD	TIMBUF+G.TISC
TBDAT:	.ASCIZ	'/'
	.WORD	TIMBUF+G.TIMO
	.WORD	TIMBUF+G.TIDA
	.WORD	TIMBUF+G.TIYR
TBDDAT:	.ASCIZ	'-'
	.WORD	TIMBUF+G.TIDA
	.WORD	TIMBUF+G.TIMO
	.WORD	TIMBUF+G.TIYR
MONTH:	.ASCII	/JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC/
DDAT00:	MOV	#TBDDAT,-(SP)
	BR	DATIM
TIM00:	MOV	#TBTIM,-(SP)
	BR	DATIM
DAT00:	MOV	#TBDAT,-(SP)
DATIM:
	MOV	R1,R3		;SAVE TEXT PTR
	SKIP			;NEXT CHAR -> R2
	CMPB	R2,#')		;NULL ARGUMENT?
	BEQ	6$		;IF SO, GET SYSTEM TIME
	CMPB	R2,#'0		;EXPLICIT ZERO?
	BNE	8$		;IF NOT, EVALUATE (BRANCH)
	SKIP			;IF SO, CHECK NEXT CHAR FOR
	CMPB	R2,#')		;CLOSE PAREN
	BEQ	6$		;IF SO, ALSO GET SYSTEM TIME
8$:	MOV	R3,R1		;GET BACK TO START OF ARG.
	EVAL			;GET NUMBER -> AC0
	BVS	3$		;IF CLOSE PAREN, BRANCH
	STXERR			;ELSE SYNTAX ERROR
3$:	TSTF	AC0		;CHECK ANSWER
	CFCC
	BLT	NFILL		;IF NEGATIVE, RETURN NULL STRING
	CMP	(SP),#TBTIM	;TIME OR DATE?
	BNE	9$		;IF DATE, BRANCH
	JSR	PC,TFILL	;FILL IN TIME FROM AC0
	BR	7$		;AND GO FINISH IN COMMON CODE
9$:	CFCC			;GET RESULTS OF LAST FP TEST
	BEQ	NFILL		;IF CALCULATED ZERO DATE, RETURN NULL STRING
	JSR	PC,DFILL	;FILL IN DATE FROM AC0
	BR	7$
6$:	GTIM$S	#TIMBUF
7$:	MOV	(SP)+,R3	;TABLE ADDRESS IN R3
	MOV	(R3)+,R4	;DELIMITING CHAR IN R4
	MOV	R1,-(SP)	;SAVE R1 ON STACK
	MOV	ENUDAT,R0	;R0 CONTAINS ADDRESS OF RESULTING STRING
	MOV	#160012,(R0)+	;PUT IN HEADER FOR SCRATCH STRING
	MOV	@(R3)+,R1
	CMP	R4,#'-		;IS IT DEC DATE?
	BEQ	4$		;IF SO, BRANCH
	JSR	PC,2$
	MOVB	R4,(R0)+
	MOV	@(R3)+,R1
	JSR	PC,2$
5$:	MOVB	R4,(R0)+
	MOV	@(R3)+,R1
	JSR	PC,2$
	MOV	ENUDAT,R3
	TST	(R3)+		;PUSH R3 TO START OF STRING
	SUB	R3,R0		;GET LEN IN R0
	MOV	R0,R4		;NOW IN R4 WHERE IT SHOULD BE
	MOVB	R4,-2(R3)	;AND IN SCRATCH HEADER
	MOV	(SP)+,R1
	RTS	PC
2$:	CMP	#10.,R1		;IS NUMBER GE 10.?
	BLE	1$		;IF SO, OK
	MOVB	#'0,(R0)+	;IF NOT, INSERT LEADING ZERO
1$:	CLR	R2		;NO LEADING ZEROES
	JSR	PC,$CBDMG	;USE LIBRARY CONVERSION ROUTINE
	RTS	PC
4$:
	JSR	PC,1$		;CONVERT DAY WITHOUT LEADING 0
	MOVB	R4,(R0)+	;PUT IN DELIMITER
	MOV	@(R3)+,R2	;MONTH -> R2
	DEC	R2		;DECREMENT FOR OFFSET
	MOV	R2,R1		;AND COPY FOR MPY BY 3
	ASL	R2		;BY DOING SHIFT
	ADD	R1,R2		;AND ADD
	MOV	#MONTH,R1	;OFFSET INTO MONTH
	ADD	R2,R1		;TABLE
	MOVB	(R1)+,(R0)+	;PUT IN 3 CHAR
	MOVB	(R1)+,(R0)+	;MONTH
	MOVB	(R1)+,(R0)+	;
	BR	5$		;AND GO FINISH IN PREVIOUS CODE
NFILL:	TST	(SP)+		;POP ADDRESS OFF STACK
	CLR	R4		;INDICATE NULL STRING
	RTS	PC		;AND RETURN
CENTUR:	.FLT2	36524.	;# OF DAYS IN A CENTURY (365*100+24 LEAP DAYS)
DAYSEC:	.FLT2	86400.	;# OF SECONDS IN A DAY
HRSEC:	.FLT2	3600.	;# OF SECONDS IN HOUR
MINSEC:	.FLT2	60.	;# OF SECONDS IN MINUTE
DFILL:
8$:	CMPF	CENTUR,AC0	;MORE THAN A CENTURY OF DAYS?
	CFCC
	BGE	7$		;IF NOT, OK (BRANCH)
	SUBF	CENTUR,AC0	;IF SO, CALCULATE MODULO ONE CENTURY
	BR	8$
7$:	LDCIF	#365.,AC2	;# DAYS IN NORMAL YEAR -> AC2
	LDCIF	#366.,AC3	;# DAYS IN LEAP   YEAR -> AC3
	CLR	R0		;YEAR COUNTER -> R0
	CMPF	AC0,AC2		;COMPARE # DAYS TO NORMAL YEAR
	CFCC
	BLE	3$		;IF THAT OR LESS, WE'RE IN '00' YEAR, SO BRANCH
	SUBF	AC2,AC0		;SUBTRACT 1 YEAR'S WORTH OF DAYS
	INC	R0		;BUMP UP THE YEAR
1$:	BIT	#3,R0		;LEAP YEAR?
	BNE	2$		;IF NOT, BRANCH
	CMPF	AC0,AC3		;DO WE HAVE OVER A LEAP YEAR OF DAYS?
	CFCC
	BLE	3$		;IF NOT, WE'VE FOUND THE RIGHT YEAR (BRANCH)
	SUBF	AC3,AC0		;ELSE SUBTRACT 366 DAYS
	INC	R0		;INCREMENT THE YEAR
	BR	1$		;AND TRY IT AGAIN
2$:	CMPF	AC0,AC2		;DO WE HAVE OVER A NORMAL YEAR OF DAYS?
	CFCC
	BLE	3$		;IF NOT, RIGHT YEAR (BRANCH)
	SUBF	AC2,AC0		;ELSE SUBTRACT 365 DAYS
	INC	R0		;INC THE YEAR
	BR	1$		;AND TRY AGAIN
3$:	STCFI	AC0,R2		;# OF DAYS INTO THIS YEAR -> R2
	MOV	#1,R3		;WE'RE AUTOMATICALLY AT LEAST IN JAN.
	MOV	#MONCHK,R4	;ADDRESS OF MONTH TABLE -> R4
5$:	MOVB	(R4)+,R5	;# OF DAYS FOR THIS MONTH -> R5
	CMP	R3,#2		;CHECKING FEB.?
	BNE	4$		;IF NOT, BRANCH
	BIT	#3,R0		;LEAP YEAR?
	BNE	4$		;IF NOT, BRANCH
	TST	R0		;ZERO YEAR?
	BEQ	4$		;IF SO, ALSO NOT LEAP YEAR
	INC	R5		;WE HAVE FEB. OF LEAP YEAR, SO MAKE IT 29.
4$:	CMP	R2,R5		;COMPARE DAYS LEFT TO MONTH IN R5
	BLOS	6$		;IF NO EXCESS, THIS IS THE MONTH (BRANCH)
	SUB	R5,R2		;ELSE SUBTRACT DAYS FOR THIS MONTH
	INC	R3		;INCREMENT THE MONTH
	CMP	R3,#12.		;ARE WE AT DECEMBER?
	BLO	5$		;IF NOT, GO AROUND AGAIN
6$:	MOV	R0,TIMBUF+G.TIYR	;STORE YEAR
	MOV	R3,TIMBUF+G.TIMO	;MONTH
	MOV	R2,TIMBUF+G.TIDA	;DAY
	RTS	PC
TFILL:
	CMPF	DAYSEC,AC0	;FIRST GET # SECONDS
	CFCC			;MODULO 1 DAY
	BGT	1$
	SUBF	DAYSEC,AC0
	BR	TFILL
1$:	MOV	#TBTIM+2,R5	;ADDRESS TABLE FOR RESULTS
	MOV	#HRSEC,R4	;ANOTHER TABLE -> R4
	LDF	AC0,AC2		;COPY # SEC -> AC2
	DIVF	(R4),AC2	;# HRS -> AC2
	MODF	#1,AC2		;INTEGER HOURS -> AC3
	STCFI	AC3,@(R5)+	;HOURS -> SLOT
	LDF	(R4)+,AC2	;SEC/HR -> AC2
	MULF	AC3,AC2		;CALC # SECS IN INTEGER HOURS
	SUBF	AC2,AC0		;AND SUBTRACT THEM (< 1 HR LEFT)
	LDF	AC0,AC2		;COPY # SECS -> AC2
	DIVF	(R4),AC2	;# MINUTES -> AC2
	MODF	#1,AC2		;INTEGER MINUTES -> AC3
	STCFI	AC3,@(R5)+	;MIN -> SLOT
	LDF	(R4),AC2	;SEC/MIN -> AC2
	MULF	AC3,AC2		;CALC # SECS IN INTEGER MINUTES
	SUBF	AC2,AC0		;AND LEAVE < 1 MIN. OF SECONDS
	STCFI	AC0,@(R5)+	;SEC -> SLOT
	RTS	PC

	.SBTTL	DCEN - DAY OF CENTURY AND DATE VALIDITY CHECK
;+4
; .S
; .X <DCEN
; .X ^DAY OF CENTURY FUNCTION
; .X ^DATE VALIDITY CHECK
; .HEADERLEVEL 1 <DCEN
; .BR
; ^THIS FUNCTION ACCEPTS A SINGLE STRING DATE ARGUMENT AND RETURNS A
; NUMBER WHICH IS THE DAY OF THE CENTURY. ^THE DATE ARGUMENT MAY BE
; THE COMMON SLASH NOTATION OF <MM/DD/YY, THE <DEC STANDARD NOTATION
; OF <DD-MMM-YY OR THE UNDELIMITED FORM OF <MMDDYY. ^THE RESULTING
; NUMBER IS THE NUMBER OF THE DAY IN THE CENTURY WITH 1 CORRESPONDING
; TO 1-^JAN-00, AND 36524 CORRESPONDING TO 31-^DEC-99. ^THIS NUMBER
; IS THUS SUITABLE FOR CALCULATING DIFFERENCES BETWEEN TWO DATES. ^A
; THOROUGH CHECK IS MADE OF THE DATE STRING BEFORE THE CONVERSION AND
; AN ERROR CODE WILL BE RETURNED INSTEAD OF THE DAY OF THE CENTURY IN
; CASE OF AN ERROR. ^THEREFORE THIS FUNCTION MAY BE USED TO VERIFY DATES
; WHICH ARE INPUT FROM A USER PROGRAM. ^THIS ROUTINE IS PROGRAMMED TO
; ACCOUNT FOR 24 LEAP YEARS PER CENTURY, OMITTING A LEAP YEAR DURING
; THE '00' YEAR. ^THE ERROR CODES RETURNED ARE AS FOLLOWS:
; .NF
; 	 0 = ^NULL STRING SUPPLIED
; 	-1 = ^BAD DATE FORMAT
;	-2 = ^BAD DAY OF MONTH
;	-3 = ^BAD MONTH (NOT IN RANGE 1-12)
; 	-4 = ^BAD YEAR  (NOT IN RANGE 0-99)
; ^EXAMPLES:
; ^^
; 	{150 A=DCEN("12/15/46")}
; 	{160 B=DCEN("5-AUG-72")}
; 	{170 C=DCEN(DDAT$(0))}
;	{180 D=DCEN("121546")}
; \\
; .F
;-
MONCHK:	.BYTE	31.,28.,31.,30.,31.,30.,31.,31.,30.,31.,30.,31.
	.EVEN
MONTOT:	.WORD	0.,31.,59.,90.,120.,151.,181.,212.,243.,273.,304.,334.
DCEN0:
	EVALS			;GET STRING ARGUMENT
	BVC	25$		;IF OK, BRANCH
1$:	STXERR			;ELSE SYNTAX ERROR
25$:	SKIP			;CHECK NEXT CHAR
	CMPB	R2,#')		;SHOULD BE CLOSE PAREN
	BNE	1$		;IF NOT, ALSO SYNTAX ERROR
	MOV	R1,2(SP)	;SAVE TEXT PTR IN SLOT
	TST	R4		;CHECK LENGTH OF STRING
	BNE	18$		;IF NON-ZERO, CONTINUE
	LDCIF	#0,AC0		;SET ZERO RETURN
	RTS	PC		;AND RETURN
18$:	CLR	-(SP)		;DAY
	CLR	-(SP)		;MONTH
	CLR	-(SP)		;YEAR
	MOV	R3,R0		;ADDRESS OF STRING -> R0
	ADD	R4,R3		;R3 NOW HAS END OF STRING ADD.
	CLRB	(R3)		;MAKE SURE WE TERMINATE
	CMP	R4,#6		;6 OR LESS CHARS?
	BGT	20$		;IF MORE, CANNOT BE UNDELIMITED FORM (BRANCH)
	CMPB	1(R0),#'/	;CHECK ONE OF TWO POSSIBLE POSITIONS FOR
	BEQ	20$		;SLASH, IF SO, GO TO SLASH CODE
	CMPB	2(R0),#'/	;NOW CHECK OTHER POSITION
	BEQ	20$
	JMP	21$		;IF NEITHER, MUST HAVE UNDELIMITED DATE
20$:	JSR	PC,$CDTB	;DECIMAL(ASCII) -> BINARY
				;DELIMITER -> R2
	CMPB	R2,#'-		;IS IT DASH?
	BEQ	2$		;IF SO, DEC STD DATE NOTATION (BRANCH)
	CMPB	R2,#'/		;OR IS IT COMMON SLASH NOTATION?
	BNE	13$		;IF NEITHER, BOGUS DATE (BRANCH)
	DEC	R1		;MONTH-1 -> R1
	BMI	15$		;IF NEG, BAD MONTH
	CMP	R1,#12.		;CHECK HIGH END OF MONTH RANGE
	BHIS	15$		;REPORT BAD MONTH IF OVER 12.
	MOV	R1,2(SP)	;STORE MONTH-1
	JSR	PC,$CDTB	;CONVERT DAY OF MONTH
				;DELIMITER -> R2
	CMPB	R2,#'/		;DO WE HAVE PROPER DELIMITER?
	BNE	13$		;IF NOT, REPORT ERROR
	MOV	R1,4(SP)	;SAVE DAY OF MONTH
	BR	7$		;GO TO COMMON YEAR PROCESSING
2$:	MOV	R1,4(SP)	;SAVE DAY OF MONTH
	MOV	#MONTH,R1	;ASCII MONTH TABLE START -> R1
	MOV	R3,-(SP)	;SAVE END OF SOURCE STRING POSITION
	CLR	R2		;R2 IS MONTH-1 COUNTER
	MOV	R1,R5		;REMEMBER WHAT MONTH IN R5
	MOV	R0,R4		;REMEMBER START OF SOURCE MONTH
6$:	MOV	#3,R3		;3 CHARS TO COMPARE
3$:	CMPB	(R0)+,(R1)+	;SEE IF MONTH MATCHES
	BNE	4$		;IF NOT, BRANCH
	SOB	R3,3$		;IF WE FINISH LOOP
	MOV	(SP)+,R3	;THEN RESTORE R3
	MOV	R2,2(SP)	;SAVE THE MONTH,
	CMPB	(R0)+,#'-	;CHECK DELIMITER
	BNE	13$		;IF BOGUS, ERROR
	BR	7$		;ELSE CONTINUE WITH COMMON YEAR CODE
4$:	CMP	R2,#11.		;DID WE JUST CHECK OUR LAST MONTH?
	BLO	5$		;IF NOT, BRANCH
	MOV	(SP)+,R3	;IF SO, RESTORE TEXT PTR
	BR	15$		;AND REPORT ERROR IN MONTH
5$:	ADD	#3,R5		;MOVE DOWN INTO MONTH TABLE
	MOV	R5,R1		;RESET PTR
	MOV	R4,R0		;ALSO SOURCE PTR
	INC	R2		;KEEP TRACK OF MONTH-1
	BR	6$		;AND TRY AGAIN
7$:	CMP	R0,R3		;CHECK POSITION AGAINST END
	BHIS	13$		;IF AT OR PAST END, ERROR
	JSR	PC,$CDTB	;GET YEAR -> R1
	DEC	R0		;BACK UP TEXT PTR
	CMP	R0,R3		;COMPARE WITH WHERE WE SHOULD END
	BNE	13$		;IF NOT, DATE FORMAT ERROR
27$:	MOV	R1,(SP)		;SAVE IT
	CMP	R1,#99.		;CHECK HIGH END
	BHI	16$		;IF OVER, ALSO ERROR
	CMP	2(SP),#1	;FEBRUARY?
	BNE	8$		;IF NOT, CAN SKIP LEAP YEAR BUSINESS
	BIT	#3,R1		;OTHER THAN MULTIPLE OF FOUR?
	BNE	8$		;IF SO, CAN ALSO SKIP LEAP YEAR
	TST	R1		;ZERO YEAR?
	BEQ	8$		;IF SO, ALSO NOT LEAP YEAR
	MOV	#29.,R2		;IF WE GOT HERE, IT IS FEB OF LEAP YEAR
	BR	9$		;GO TO CHECK
8$:	MOV	2(SP),R0	;MONTH-1 -> R0
	MOVB	MONCHK(R0),R2	;PROPER # OF DAYS -> R2
9$:	CMPB	4(SP),R2	;CHECK DAY OF MONTH AGAINST R2
	BHI	14$		;IF HIGH, ERROR
	TST	4(SP)		;CHECK LOW END
	BLE	14$		;IF ZERO OR LESS, ALSO BAD
;
; NOW READY TO CALCULATE DAY OF CENTURY
;
	MOV	(SP),R0		;# YRS -> R0
	LDCIF	R0,AC0		;# YRS SINCE START OF START OF CENTURY -> AC0
	LDCIF	#365.,AC2	;
	MULF	AC2,AC0		;365 DAYS/YR (NORMAL YEARS)
	DEC	R0		;DON'T INCLUDE CURRENT YEAR YET
	BLT	10$		;IF '00' YEAR, BRANCH
	ASH	#-2,R0		;DIVIDE BY FOUR
	LDCIF	R0,AC1		;# LEAP YEARS -> AC1
	ADDF	AC1,AC0		;ADD IT TO TOTAL DAYS
10$:	MOV	(SP)+,R0	;YEAR -> R0
	MOV	(SP)+,R1	;MONTH-1 -> R1
	CLR	R2		;SET NO LEAP YEAR
	CMP	R1,#2		;MARCH OR LATER?
	BLT	11$		;IF NOT, DON'T WORRY ABOUT LEAP YEAR
	BIT	#3,R0		;IS THIS MULTIPLE OF FOUR?
	BNE	11$		;IF NOT, BRANCH (NO LEAP YEAR)
	TST	R0		;IS THIS '00' YEAR?
	BEQ	11$		;ALSO NOT LEAP YEAR
	INC	R2		;IF WE GOT HERE, THEN IT'S LEAP YEAR PAST FEB
11$:	ASL	R1		;MPY MONTH-1 BY 2 (FOR WORD OFFSET)
	ADD	MONTOT(R1),R2	;ADD IN TOTAL OF PREVIOUS MONTHS
	ADD	(SP)+,R2	; AND DAYS OF THIS MONTH
	LDCIF	R2,AC1		;TOTAL DAYS FOR THIS YEAR -> AC1
	ADDF	AC1,AC0		;NOW WE HAVE IT!
12$:	RTS	PC
;
; ERROR RETURN PROCESSING
;
13$:	LDCIF	#-1,AC0		;BAD DATE FORMAT RETURN
	BR	17$
14$:	LDCIF	#-2,AC0		;BAD DAY OF MONTH
	BR	17$
15$:	LDCIF	#-3,AC0		;BAD MONTH OF YEAR
	BR	17$
16$:	LDCIF	#-4,AC0		;BAD YEAR OF CENTURY
17$:	ADD	#6,SP		;CLEAN UP STACK
	BR	12$		;AND GO TO RETURN
;
; DO 5 OR 6 DIGIT NON-DELIMITED DATE
;
30$:	.FLT4	.01		;FLOATING 1/100.
21$:	MOV	R0,R1		;STRING ADDRESS -> R1
	MOV	R3,-(SP)	;SAVE OUR END POSITION
	ATOF			;MAKE STRING INTO FLOATING NUMBER
	CMP	(SP)+,R1	;WE MUST NOW BE AT END OF STRING
	BNE	13$		;ELSE ERROR (BRANCH)
	STF	AC0,-(SP)	;SAVE RESULT
	SETD			;MAKE SURE WE DON'T LOSE ANYTHING
	LDCFD	(SP)+,AC0	;GET OUR RESULT BACK IN DOUBLE PRECISION
	ADDD	30$,AC0		;MAKE US JUST A LITTLE > INTEGER
	MODD	30$,AC0		;YEAR/100 -> AC0; MO,DA -> AC1
	DIVD	30$,AC0		;INTEGER YEAR -> AC0
	STCDI	AC0,R1		;YEAR -> R1
	LDD	AC1,AC0		;COPY REST BACK -> AC0
	ADDD	30$,AC0		;MAKE SURE JUST > INTEGER
	MODD	30$,AC0		;DAY/100 -> AC0; MO -> AC1
	DIVD	30$,AC0		;INTEGER DAY -> AC0
	STCDI	AC0,4(SP)	;DAY -> SLOT ON STACK
	STCDI	AC1,R0		;MONTH -> R0
	SETF			;BACK TO REGULAR FLOATING
	DEC	R0		;MONTH-1 -> R0
	CMP	R0,#12.		;IF 12. OR MORE (OR NEG.)
	BHIS	15$		;BRANCH TO ERROR ROUTINE
	MOV	R0,2(SP)	;SAVE VERIFIED MONTH
	BR	27$

	.SBTTL	SEC - SECONDS FROM TIME FUNCTION
;+4
; .S
; .X <SEC
; .X ^NUMBER OF SECONDS FROM TIME
; .X ^TIME STRING VALIDITY CHECK
; .HEADERLEVEL 1 <SEC
; .BR
; ^THIS FUNCTION ACCEPTS A SINGLE STRING TIME ARGUMENT AND RETURNS
; A NUMBER WHICH IS THE NUMBER OF SECONDS SINCE MIDNIGHT. ^THE TIME
; STRING MUST BE IN THE FORM <HH:MM:SS IN 24 HOUR NOTATION. ^THE
; STRING IS CHECKED FOR VALIDITY AND IF VALID, A POSITIVE (OR ZERO)
; NUMERIC VALUE IS RETURNED. ^IF AN ERROR IS DETECTED, A NEGATIVE
; OR ZERO VALUE IS RETURNED AS FOLLOWS:
; .NF
; 	 0 = ^NULL STRING ARGUMENT (OR 00:00:00)
; 	-1 = ^BAD TIME FORMAT
;	-2 = ^BAD SECONDS
; 	-3 = ^BAD MINUTES
; 	-4 = ^BAD HOURS
; ^EXAMPLES:
; ^^
; 	{210 A=SEC("12:05:31")}
; 	{220 B=SEC(A$)}
; \\
; .F
;-
SEC00:
	EVALS			;GET STRING ARGUMENT
	BVC	2$		;IF OK, BRANCH
1$:	STXERR			;ELSE REPORT ERROR
2$:	SKIP			;CHECK OUT NEXT CHAR
	CMPB	R2,#')		;MUST BE CLOSE PAREN
	BNE	1$		;IF NOT, REPORT SYNTAX ERROR
	MOV	R1,2(SP)	;SAVE TEXT PTR IN SLOT
	TST	R4		;CHECK LENGTH
	BEQ	13$		;IF ZERO, BRANCH
	ADD	R3,R4		;R4 NOW AT END OF STRING
	MOVB	#':,(R4)+	;PUT IN FINAL TERMINATOR
	SUB	#6,SP		;MAKE SLOTS FOR 3 NUMBERS
	MOV	SP,R5		;R5 IS PTR TO 3 SLOTS
	MOV	R4,-(SP)	;SAVE END OF STRING PTR
	MOV	R3,R0		;STRING ADD -> R0
	MOV	#20$,R4		;CHECKING TABLE ADDRESS -> R4
	MOV	#3,R3		;GO THROUGH LOOP 3 TIMES
3$:	JSR	PC,$CDTB	;CONVERT NUMBER (TERMINATOR -> R2)
	CMPB	R2,#':		;MUST BE COLON
	BNE	10$		;IF NOT DATE FORMAT ERROR (BRANCH)
	CMP	R1,(R4)+	;CHECK OUT RANGE OF NUMBER
	BHI	12$		;IF TOO MUCH OR NEGATIVE, BRANCH
	MOV	R1,(R5)+	;IF GOOD, PUT IT AWAY
	SOB	R3,3$
	CMP	(SP)+,R0	;DO WE END UP WHERE WE SHOULD?
	BNE	11$		;IF NOT, BRANCH
	LDCIF	#60.,AC1	;MULTIPLIER -> AC1
	LDCIF	(SP)+,AC0	;HOURS -> AC0
	MULF	AC1,AC0		;HOURS -> MINUTES -> AC0
	LDCIF	(SP)+,AC2	;MINUTES -> AC2
	ADDF	AC2,AC0		;TOTAL MINUTES -> AC0
	MULF	AC1,AC0		;MINUTES -> SECONDS -> AC0
	LDCIF	(SP)+,AC2	;ODD SECONDS -> AC2
	ADDF	AC2,AC0		;TOTAL SECONDS -> AC0
4$:
	RTS	PC
10$:	TST	(SP)+		;POP END OF STRING PTR
11$:	ADD	#6,SP		;GET RID OF NUMBER SLOTS
	LDCIF	#-1,AC0		;PUT IN BAD TIME FORMAT ERROR CODE
	BR	4$		;AND GO RETURN
12$:	INC	R3		;PUSH UP LOOP COUNTER
	NEG	R3		;AND MAKE IT NEGATIVE ERROR CODE
	LDCIF	R3,AC0		;STORE IT AWAY
	ADD	#10,SP		;CLEAN STACK
	BR	4$		;AND RETURN
13$:	CLRF	AC0		;SET ZERO RESULT
	BR	4$		;AND RETURN
20$:	.WORD	23.
	.WORD	59.
	.WORD	59.

	.SBTTL	FRMT$ - NUMERIC TO STRING FORMAT FUNCTION
;+5
; .S
; .X <FRMT$
; .X ^NUMERIC TO STRING FORMAT FUNCTION
; .HEADERLEVEL 1 <FRMT$(X,W[,D])
; .BR
; ^THIS FUNCTION CREATES A STRING FROM A NUMBER ALLOWING CONTROL OVER THE
; TOTAL NUMBER OF DIGITS AND THE
; NUMBER OF DIGITS TO THE RIGHT OF THE DECIMAL POINT. ^THE VALUE TO BE
; CONVERTED IS ^X, THE NUMBER OF TOTAL DIGITS (INCLUDING SIGN AND DECIMAL POINT)
; IS ^W AND THE NUMBER OF DIGITS TO THE RIGHT OF THE DECIMAL
; POINT IS ^D. ^IF ^D IS UNSPECIFIED, THEN THE NUMBER PRODUCED IS AN
; INTEGER WITH NO DECIMAL POINT. ^IF ^D IS ZERO, THEN THE NUMBER PRODUCED
; WILL HAVE A DECIMAL POINT BUT NO NUMBERS TO THE RIGHT. ^IF A NEGATIVE
; NUMBER IS GIVEN FOR ^D, THEN THE OUTPUT WILL BE FILLED WITH ^W ASTERISKS
; UNLESS ^W IS ZERO OR LESS. ^IF ^W IS LESS THAN OR EQUAL ZERO, IN ANY CASE
; THEN A NULL STRING WILL BE RETURNED.
; ^IF ^W IS POSITIVE NON-ZERO AND UNABLE TO FIT THE NUMBER,
; A STRING OF ^W ASTERISKS WILL BE RETURNED.
; ^NOTE THAT
; MEANINGLESS DIGITS WILL BE PRODUCED IF MORE THAN 6 OR 7 ARE ASKED FOR.
; ^IF ONLY SIGNIFICANT DIGITS ARE WANTED, USE <STR$.
; ^NUMBERS ARE ROUNDED FOR PRINTOUT.
; .BR
; ^EXAMPLE:
; .NF
; ^^
; 	{130 A$=FRMT$(A+6,5,2)}
; 	{140 B$=FRMT$(12.75+Z1,7)}
; \\
; .F
;-
FORM00:
	EVAL			;NUMBER TO BE CONVERTED -> AC0
	BVS	99$		;IF CLOSE PAREN, ERROR (BRANCH)
	STF	AC0,-(SP)	;SAVE X
	SKIP			;NEXT CHAR
	CMPB	R2,#',		;MUST BE COMMA
	BNE	99$		;ELSE ERROR (BRANCH)
	EVAL			;W -> AC0
	STF	AC0,-(SP)	;STORE IT (COND. CODES NOT DISTURBED)
	BVC	1$		;IF NO CLOSE PAREN, BRANCH
	MOV	#-1,R0		;IF D NOT SPEC'D, USE -1
	BR	2$
99$:	STXERR
1$:	SKIP			;NEXT CHAR -> R2
	CMPB	R2,#',		;MUST BE COMMA
	BNE	99$		;ELSE ERROR
	EVAL			;D -> AC0
	BVC	99$		;MUST HAVE CLOSE PAREN, ELSE ERROR
	STCFI	AC0,R0		;D -> R0
	BMI	41$		;IF NEG, GO TO ERROR FILL
2$:	LDF	(SP)+,AC0	;W -> AC0
	STCFI	AC0,R2		;W -> R2
	BLE	30$		;IF NEG OR ZERO, GO RETURN NULL STRING
	ADD	#2,R0		;W MUST BE AT LEAST 2 GREATER THAN D
	CMP	R2,R0		;CHECK W VS D+2
	BLT	40$		;IF W < D+2, THEN ERROR FILL
	SUB	#2,R0		;RESTORE ORIGINAL D
	SETD			;SET DOUBLE PRECISION, SO DON'T LOSE DIGITS
	CLRD	AC2		;SET NO SIGN
	LDCFD	(SP)+,AC0	;X -> AC0
	CFCC			;
	BGE	11$		;IF POS OR ZERO, BRANCH
	ADDD	#1,AC2		;INDICATE '-' NEEDED
	ABSD	AC0		;AND MAKE POSITIVE
11$:	LDCID	R2,AC3		;SAVE W -> AC3
	INC	R2		;ROUND UP W
	BIC	#1,R2		;
12$:	SUB	R2,SP		;MAKE ROOM ON STACK
	MOV	SP,R5		;PUT PTR FOR STRING -> R5
	MOV	R2,-(SP)	;SAVE ROUNDED UP W
	MOV	R0,-(SP)	;SAVE D
	TST	R0		;POSITIVE D?
	BLE	4$		;IF NOT, BRANCH
3$:	MULD	#10.,AC0	;SCALE US UP
	SOB	R0,3$		;BY D FACTORS OF TEN
4$:	MODD	#1,AC0		;INTEGER -> AC1, FRACTION -> AC0
	CMPD	#.5,AC0		;SHOULD WE ROUND UP?
	CFCC
	BGT	5$		;IF POS, NO
	ADDD	#1,AC1		;ELSE ADD 1
5$:	LDD	AC1,AC0		;INTEGER BACK -> AC0
	STCDI	AC3,R2		;W -> R2
	MOV	(SP)+,R0	;D -> R0
	BLE	7$		;NEG OR ZERO, BRANCH
6$:	JSR	PC,20$		;DO DIGIT CONVERSION
	DEC	R2		;KNOCK OFF 1 FROM TOTAL LEFT
	SOB	R0,6$		;DO IT D TIMES
7$:	BLT	8$		;IF R0 NEG, BRANCH (SKIP '.')
	MOVB	#'.,(R5)+	;PUT IN DECIMAL POINT
	DEC	R2		;ACCOUNT FOR IT
8$:	TST	R2		;ANY W LEFT?
	BEQ	10$		;IF NOT, BRANCH TO FINAL CHECK
9$:	TSTD	AC0		;ANYTHING LEFT TO CONVERT?
	CFCC
	BEQ	13$		;IF DONE, BRANCH
	JSR	PC,20$		;CONVERT DIGIT
	SOB	R2,9$		;KEEP GOING TILL NUMBER DONE
10$:	TSTD	AC0		;IF WE GOT HERE, CHECK IF
	CFCC			;ANYTHING LEFT
	BGT	42$		;IF SO, ERROR
	TSTD	AC2		;SIGN?
	CFCC
	BGT	42$		;IF SO, ALSO ERROR
	BR	16$		;ELSE GO TO COPY CODE
13$:	STCDI	AC3,R0		;ORIGINAL W -> R0
	CMP	R0,R2		;IS IT SAME AS LEFT (NOTHING PRINTED YET)?
	BEQ	22$		;IF SO, BRANCH
	CMPB	-1(R5),#'.	;DO WE HAVE ANYTHING TO LEFT OF DECIMAL
	BNE	21$		;IF SO, BRANCH
22$:	MOVB	#'0,(R5)+	;IF NOT, PUT IN LEADING 0
	DEC	R2		;KEEP TRACK OF HOW MANY CHARS LEFT
21$:	TSTD	AC2		;CHECK IF SIGN NEEDED
	CFCC
	BLE	14$		;IF NOT, BRANCH
	TST	R2		;ANY ROOM LEFT?
	BLE	42$		;IF NOT, BRANCH TO ERROR FILL
	MOVB	#'-,(R5)+	;PUT IN SIGN
	DEC	R2		;ACCOUNT FOR IT
14$:	TST	R2		;ANY SPACE LEFT?
	BEQ	16$		;IF NOT, GO TO COPY CODE
15$:	MOVB	#40,(R5)+	;FINISH FILLING STRING
	SOB	R2,15$		;WITH BLANKS
16$:	MOV	(SP),R0		;W -> R0
	MOV	R5,R2		;STRING PTR -> R2
	TSTOK			;CHECK FOR ROOM (ENUDAT -> R5)
	BHIS	17$		;IF OK, BRANCH
19$:	OVFERR			;ELSE OVERFLOW
17$:	STCDI	AC3,R0		;W -> R0
	MOV	R0,R4		;ALSO -> R4
	BIS	#160000,R0	;SET HEADER
	MOV	R0,(R5)+	;PUT IT AWAY
	MOV	R5,R3		;SET START OF STRING
	MOV	R4,R0		;RESET W -> R0
18$:	MOVB	-(R2),(R5)+	;COPY THE STRING
	SOB	R0,18$		;INTO SCRATCH AREA
	MOV	(SP)+,R0	;ROUNDED UP W -> R0
	ADD	R0,SP		;CLEAN STACK
	SETF
	RTS	PC
20$:	MODD	M.PT1,AC0	;INTEGER -> AC1, REM. -> AC0
	MULD	M.TEND,AC0	;GET DIGIT BACK
	STCDI	AC0,R4		;MAKE IT 16 BITS
	ADD	#60,R4		;AND NOW ASCII CHAR
	MOVB	R4,(R5)+	;PUT IT AWAY
	LDD	AC1,AC0		;COPY REST OF NUMBER BACK
	RTS	PC
30$:	ADD	#4,SP		;CLEAN STACK
31$:	CLR	R4		;RETURN NULL STRING
	SETF
	RTS	PC
42$:	MOV	(SP)+,R0	;ROUNDED UP W -> R0
	ADD	R0,SP		;CLEAN STACK
	STCDI	AC3,R0		;W -> R0
	SETF			;BACK TO FLOATING MODE
	BR	44$
;
; W ON STACK, X ON STACK
;
41$:	LDF	(SP)+,AC0	;W -> AC0
	STCFI	AC0,R0		;W -> R0
	BLE	31$		;IF ZERO OR NEG, NULL RETURN
	BR	43$
;
; X ON STACK, W IN R2
;
40$:	MOV	R2,R0		;W -> R0
43$:	ADD	#4,SP		;CLEAN STACK
44$:	TSTOK			;CHECK FOR ROOM
	BLO	19$		;IF NOT, REPORT OVERFLOW
	MOV	R0,R4		;COPY LEN
	BIS	#160000,R0	;SET HEADER
	MOV	R4,R0		;GET BACK UNADULTERATED W
	MOV	R5,R3		;REMEMBER STRING START
45$:	MOVB	#'*,(R5)+	;PUT IN STARS
	SOB	R0,45$		;
	RTS	PC		;AND RETURN

	.SBTTL	RJS00 - RIGHT JUSTIFY STRING FUNCTION
;+5
; .SKIP
; .X ^^RJS$\\
; .X ^^LJS$\\
; .X ^RIGHT JUSTIFY FUNCTION
; .HEADERLEVEL 1 <RJS$ . . <LJS$
; .BREAK
; .NOFILL
; ^FORMAT:
;	^^RJS$(B$,I)\\
; 	^^LJS$(B$,I)\\
; .FILL
; ^WHERE ^I IS THE LENGTH OF THE RETURNED STRING WITH ^B$ RIGHT
; OR LEFT
; JUSTIFIED IN IT AND WITH LEADING OR TRAILING BLANK FILL
; IF NECESSARY.
; ^IF ^B$ IS LONGER THAN ^I CHARACTERS, THEN THE RIGHTMOST
; OR LEFTMOST ^I
; CHARACTERS WILL BE RETURNED.
; .BREAK
; ^EXAMPLE:
; .NOFILL
; ^^
;	{40 A$=RJS$(B$,9)}
; 	{70 A$=LJS$(B$,5)}
; \\
; .FILL
;-
; ON RETURN:	R3 CONTAINS ADDRESS
;		R4 CONTAINS LENGTH
;
LJS00:	MOV	#1,-(SP)	;SET FLAG FOR LEFT JUSTIFY
	BR	RJS01
RJS00:	CLR	-(SP)		;CLEAR FLAG
RJS01:	EVALS			;GET STRING IN WORK AREA
	BVC	1$		;CHECK FOR ERROR
2$:	STXERR
1$:	SKIP
	CMPB	R2,#',		;NEXT CHAR MUST BE ','
	BNE	2$		;ELSE ERROR
	MOV	R4,-(SP)	;SAVE LEN
	MOV	R3,-(SP)	;AND ADDRESS
	MOV	ENUDAT,-(SP)	;SAVE ENUDAT
	ADD	R4,R3		;ACCOUNT FOR STRING
	MOV	R3,R5
	INC	R5		;MAKE SURE EVEN
	BIC	#1,R5
	MOV	R5,ENUDAT	;SET NEW END OF USER LIST
	EVAL			;GET REQ'D LEN
	BVC	2$		;MUST HAVE ')'
	MOV	(SP)+,ENUDAT	;RESTORE OLD ENUDAT
	MOV	(SP)+,R3	;RESTORE ADDRESS
	STCFI	AC0,R0		;REQUESTED LEN IN R0
	BNE	21$		;IF NON-ZERO, BRANCH
	CMP	(SP)+,(SP)+	;IF REQ LEN 0, CLEAN STACK
	CLR	R4		;RETURN 0 LEN
	RTS	PC
21$:	CMP	R0,#255.	;CHECK SIZE
	BHI	2$		;IF TOO BIG OR SMALL, ERROR
3$:	MOV	(SP)+,R4	;ACTUAL LEN -> R4
	BNE	5$		;IF NON - ZERO, BRANCH
31$:	MOV	R3,R5		;DUPLICATE ADDRESS OF STRING IN R5
	MOV	R0,R4		;AND REQ'D LEN IN R4
	MOVB	#40,R2		;SPACE IN R2
4$:	MOVB	R2,(R5)+	;FILL IN SPACES
	SOB	R0,4$
	TST	(SP)+		;POP RIGHT-LEFT FLAG
	BR	62$		;AND FINISH
5$:	TST	(SP)+		;RIGHT OR LEFT JUSTIFY
	BNE	10$		;IF LEFT JUSTIFY, BRANCH
; RIGHT JUSTIFY CODE
	MOV	R3,R2		;DUPLICATE STRING ADDRESS IN R2
	ADD	R4,R2		;MAKE R2 POINT PAST END OF ACTUAL STRING
51$:	CMPB	#40,-(R2)	;BLANK TRIM THE STRING FROM THE END
	BNE	52$
	SOB	R4,51$
53$:	TST	-(SP)		;FAKE FLAG ON STACK
	BR	31$		;AND FINISH
52$:	MOV	R4,R5		;DUPLICATE TRIMMED LEN IN R5
	BEQ	31$		;IF ZERO, BRANCH AND RETURN BLANK STRING
	MOV	R3,R2		;DUPLICATE ADDRESS IN R2
	SUB	R0,R5		;ACTUAL MINUS REQUESTED LENGTH IN R5
	BLT	7$		;IF ACTUAL LESS THAN REQUESTED, BRANCH
	ADD	R5,R2		;MAKE R2 POINT TO START OF REMAINING STRING
	MOV	R3,R5		;DUPLICATE STRING ADDRESS IN R5
6$:	MOVB	(R2)+,(R5)+	;SHIFT STRING LEFT SO WE GET
	SOB	R0,6$		;RIGHTMOST R0 CHARACTERS
61$:	STCFI	AC0,R4		;STORE REQ'D LEN -> R4
62$:	MOVB	R4,@ENUDAT	;AND IN SCRATCH HEADER
	RTS	PC
7$:	ADD	R0,R3		;LET R3 POINT TO REQ'D END
	ADD	R4,R2		;AND R2 POINT TO ACTUAL END
	NEG	R5		;MAKE R5 POS
8$:	MOVB	-(R2),-(R3)	;MOVE STRING TO THE
	SOB	R4,8$		;RIGHT
9$:	MOVB	#40,-(R3)	;AND FILL IN FIRST PART WITH
	SOB	R5,9$		;BLANKS
	BR	61$		;AND FINISH
; LEFT JUSTIFY CODE
10$:	MOV	R3,R2		;REPEAT STRING START ADD. -> R2
11$:	CMPB	(R2)+,#40	;TRIM OFF BEGINNING BLANKS
	BNE	12$		;BRANCH ON FIRST NON-BLANK CHAR
	SOB	R4,11$
	BR	53$		;IF WE FINISHED, RETURN BLANK STRING
12$:	DEC	R2		;MAKE R2 POINT TO FIRST NON-BLANK CHAR
	MOV	R3,R5		;DUPLICATE ADD IN R5
	MOV	R4,-(SP)	;SAVE TRIMMED LEN
13$:	MOVB	(R2)+,(R5)+	;NOW MOVE IT DOWN
	SOB	R4,13$
	SUB	(SP)+,R0	;SEE HOW WE MUCH WE NEED TO FILL
	BLE	15$		;IF ALREADY ENOUGH, BRANCH
14$:	MOVB	#40,(R5)+	;FILL IN THE BLANKS
	SOB	R0,14$
15$:	BR	61$

	.SBTTL SPACE$ AND STRING$ FUNCTIONS
;+5
; .SKIP
; .X <SPACE$
; .X <STRING$
; .HEADERLEVEL 1 <SPACE$ . . <STRING$
; .BREAK
; .NF
; ^FORMAT
; 	^^SPACE$(I)\\
; 	^^STRING$(C$,I)\\
; .F
; ^WHERE ^I IS THE LENGTH OF THE STRING TO BE CREATED.
; ^IN THE CASE OF <SPACE$, A STRING OF BLANKS IS CREATED.
; ^FOR <STRING$, A STRING OF CHARACTERS MATCHING THE FIRST
; CHARACTER OF ^C$ IS CREATED.
; ^IF ^I IS ZERO OR NEGATIVE, A NULL STRING IS RETURNED.
; .BREAK
; ^EXAMPLES:
; .NF
; ^^
; 	{120 A$=SPACE$(40)}
; 	{130 B$=STRING$("-",40)}
; \\
; .F
;-
SPACE0:	MOVB	#40,R0		;SET UP SPACE CHAR
	BR	STRG01		;REST IS SAME AS STRING$
STRG00:	EVALS			;GET CHARACTER STRING
	MOVB	(R3),R0		;AND USE FIRST CHAR
	SKIP			;SKIP PAST COMMA SEPARATOR
STRG01:	MOV	R0,-(SP)	;SAVE CHARACTER ON STACK
	EVAL			;# OF CHARS -> AC0
	BVS	1$		;SHOULD HAVE CLOSE PAREN
	STXERR			;ELSE SYNTAX ERROR
1$:	STCFI	AC0,R0		;GET CHAR COUNT
	TSTOK			;CHECK FOR ROOM (ENUDAT -> R5)
	BLO	4$		;IF NO ROOM, REPORT ERROR
	MOV	#160000,(R5)+	;PUT IN SCRATCH HEADER
	MOVB	R0,-2(R5)	;AND SET CHAR COUNT
	MOV	(SP)+,R2	;GET CHAR TO USE
	MOV	R0,R4		;COPY CHAR COUNT -> R4
	BLE	3$		;IF ZERO OR NEG., DONE
	MOV	R5,R3		;COPY START ADDRESS -> R3
2$:	MOVB	R2,(R5)+	;FILL IN THE CHARS
	SOB	R0,2$
3$:	RTS	PC		;AND RETURN
4$:	OVFERR
	.END