.;
.;
.;		C A L C . C M D
.;
.;	Do calculations and type conversions.
.;
.;	This command file can be invoked either interactively by
.;		>@CALC
.;	or as an MCR command by
.;		>@CALC calculation
.;
.;	For more details, invoke and type <ESC> in response to
.;	the prompt. To exit, type Control/Z.

.;	Author:     T. R. Wyant
.;	Date:       02-Dec-82
.;	Maintainer: Process Systems system manager
.;
.;	Modified:
.;		03-Mar-83 - T. R. Wyant
.;			Added "Mode", "Show", and "TRACE"  options.
.;			Added ability to store calculations in a variable.
.;
	.IFNDF <PRIVIL>	.GOTO BADSYS
	.IF <SYSTEM> <> 1	.IF <SYSTEM> <> 6	.GOTO BADSYS
	.ENABLE OVERFLOW
	.ENABLE SUBSTITUTION
	.ENABLE ESCAPE
	.DISABLE DISPLAY
	.SETN D$HSPA 27.
	.SETS S$ESC "'D$HSPA%V'"
	.SETS S$DSMS "/DECIMAL:DE/OCTAL:OC/RAD50:OC/ASCII:OC"
	.SETS S$DSMS S$DSMS+"/BINARY:OC/BASE:OC/HEXADECIMAL:OC"
	.SETS S$DSYN "/R5:RAD50"
	.SETS S$DSOP S$DSMS
	.SETS S$OPLS ",MODE,SHOW,TRACE"
	.SETS S$TRAC ".;"
	.SETS S$RD50 " ABCDEFGHIJKLMNOPQRSTUVWXYZ$.?0123456789"
	.SETS S$BASE "0123456789ABCDEF"
	.SETS S$V50H "'S$ESC'C'S$ESC'C'S$ESC'C'S$ESC'C'S$ESC'C"
	.SETS S$V50H S$V50H+S$V50H+S$V50H+S$V50H
	.SETS S$V50H S$V50H+S$V50H
	.SETS S$BLNK "                                        "
	.SETN D$DFIB 2.			! Default input radix for "BASE".
	.SETN D$DFOB 2.			! Default output radix for "BASE".
	.SETN X 0.			! Define and init the accumulator.

	.SETS S$TTYP "HCPY"
	.IF <TITYPE> = 8.			.SETS S$TTYP "VT50"
	.IF <TITYPE> >= 9. .IF <TITYPE> <=11.	.SETS S$TTYP "VT52"
	.IF <TITYPE> = 13.			.SETS S$TTYP "VT100"
	.IF <TITYPE> >= 20. .IF <TITYPE> <= 25.	.SETS S$TTYP "VT100"
	.SETS S$CALC "'P1' 'P2' 'P3' "
	.TEST COMMAN
	.SETN D$HSPA <STRLEN>+2
	.TEST S$CALC
	.SETN D$CALN <STRLEN>
	.SETF L$PRMP
	.IF P1 <> ""	.GOTO DOIT
	.SETT L$PRMP
;
;
;		C A L C . C M D
;
;	Do calculations and type conversions.
;	For help, type the escape key.
;
	.GOTO PROMPT

.HELP:	.;
;
;	This command file can be run either as a command line
;		(e.g.: >@CALC command)
;	or interactively
;		(e.g.: >@CALC).
;	If interactive, you will be prompted
;		"Calculation: "
;	and you enter the command in response to this prompt.
;
;	The format of the command is basically
;		Calc [[Inpcnv ]Outcnv]
;	where:
;		Calc	is the calculation to be done,
;		Inpcnv	is the input conversion option to be used,
;		Outcnv	is the output conversion option to be used.
;	The conversion option can be abbreviated to one character.
;
;	The format of the "Calc" string is:
;		[Var=]Calculation
;	where the square brackets denote optional syntax. "Var", if
;	given, must be 1-6 alphanumeric characters, and is used as
;	the name of a variable to store the result of the  calculation
;	in. The variable name "X" is reserved, and always gets the
;	result of the last calculation.
;	Note that the "Calc" string may not contain spaces.
;
;	How the calculation string is operated on depends on the
;	input conversion option selected, as follows:
;		Option	Calculation
;		-------	-----------------------------------
;		DECIMAL	Normal ICP arithmetic, in decimal.
;		OCTAL	Normal ICP arithmetic, in octal.
;		ASCII	First 2 characters to internal ASCII.
;		RAD50	First 3 characters converted to RAD50.
;		R5	Synonym for RAD50.
;		BINARY	Input treated as a binary constant.
;		HEXADECIMAL Input treated as a hexadecimal constant.
;		BASE:n	Input treated as a constant of base "n" (n=2-16)
;
;	The Indirect Command Processor (ICP) performs integer arith-
;	metic only. The following operators are defined:
;		Oper.	Use
;		-----	-----------
;		 +	Addition
;		 -	Subtraction or unary minus
;		 *	Multiplication
;		 /	Division
;		 &	Logical And
;		 !	Logical inclusive Or (Can''t use in command mode)
;		 #	Logical negation (Not).
;	An arithmetic expression is evaluated strictly LEFT to RIGHT,
;	unless parentheses are used to form subexpressions. Thus:
;		5+2*3 = 21 (decimal), not 11 (decimal);
;		5+(2*3) = 11 (decimal).
;	Numeric constants are interpreted according to the specified
;	input mode (Decimal or Octal). If the input mode is Octal,
;	a constant followed by a decimal point will be treated as
;	a decimal constant.
;
;	How the result is displayed depends on the output conversion
;	option selected, as follows:
;		Option	Display
;		-------	------------------------------------
;		DECIMAL	Signed decimal.
;		OCTAL	Magnitude octal.
;		ASCII	2 quoted characters, lo byte first.
;		RAD50	3 characters.
;		R5	Synonym for RAD50.
;		BINARY	Binary
;		HEXADECIMAL Hexadecimal.
;		BASE:n	Base "n" (n in the range 2-16)
;
;	The default output option is decimal. The input option depends
;	on the output option as follows:
;		Outopt	Default Inpopt
;		-------	--------------
;		DECIMAL	DECIMAL
;		OCTAL	OCTAL
;		ASCII	OCTAL
;		RAD50	OCTAL
;		BINARY	OCTAL
;		HEXADECIMAL OCTAL
;		BASE:n	OCTAL
;
;	The input and output defaults can be changed by use of the "MODE"
;	keyword, as follows:
;		%MODE [[Inpopt] Outopt]
;	The leading percent sign is optional unless you have defined "MODE"
;	as a variable.
;
;

.PROMPT:
	.ASKS S$CALC Calculation: 
	.IFT <ESCAPE>	.GOTO HELP
	.IF S$CALC = ""	.EXIT
	.SETN D$CALN <STRLEN>
	.SETN D$HSPA <STRLEN>+13.

.DOIT:	.SETS S$TEXT ""
	.SETS S$TEMP "'S$CALC' "
	.SETS S$TEMP "'S$TEMP%C'"
	.PARSE S$TEMP " " S$CALC S$INOP S$OUOP
	.IF S$OUOP <> ""	.GOTO SETOPT
	.SETS S$OUOP S$INOP
	.SETS S$INOP ""
.SETOPT:.SETS S$OPDF ""
	.SETS S$OUPM ""
	.SETS S$INPM ""
	.SETS S$SUFX ""
	.GOSUB ANLOPT S$OUOP S$OUPM
	.IF S$TEXT <> ""	.GOTO CLCIV
	.GOSUB ANLOPT S$INOP S$INPM
	.IF S$TEXT <> ""	.GOTO DSPIV
	'S$TRAC';	S$OUOP = "'S$OUOP'"
	'S$TRAC';	S$OUPM = "'S$OUPM'"
	'S$TRAC';	S$INOP = "'S$INOP'"
	'S$TRAC';	S$INPM = "'S$INPM'"

	.SETS S$TEMP S$CALC[1:1]
	.IF S$TEMP = "%"	.GOTO OPT
	.TEST S$CALC
	.IF <STRLEN> > 6	.GOTO CLCDSP
	.IFF <ALPHAN>		.GOTO CLCDSP
	.IFDF 'S$CALC'		.GOTO CLCDSP
	.TEST S$OPLS ",'S$CALC'"
	.IF <STRLEN> = 0	.GOTO CLCDSP
	.GOTO OPTI

.OPT:	.SETS S$CALC S$CALC[2:*]
	.TEST S$OPLS ",'S$CALC'"
	.IF <STRLEN> > 0	.GOTO OPTI
	.SETS S$TEXT "-- Invalid option name '''S$CALC'''."
	.GOTO 'S$TTYP'
.OPTI:	.SETS S$TEMP S$OPLS[<STRLEN>+1:*]
	.PARSE S$TEMP "," S$OPNM S$TEMP
	.SETS S$OPNM S$OPNM[1:3]
	.SETS S$TEMP ","+S$TEMP
	.TEST S$TEMP ",'S$CALC'"
	.IF <STRLEN> = 0	.GOTO OPN'S$OPNM'
	.SETS S$TEXT "-- Non-unique option abbreviation '''S$CALC'''."
	.GOTO 'S$TTYP'
.OPNMOD:.TEST S$DSOP "/'S$OUOP'"
	.SETS S$DSOP S$DSOP[<STRLEN>+1:*]+S$DSOP[1:<STRLEN>-1]
	.PARSE S$DSOP ":/" S$TEMP S$TMP2 S$DSOP
	.SETS S$DSOP "/'S$TEMP':'S$INOP'/"+S$DSOP
	.IF S$OUOP = "BA"	.GOSUB SETRDX D$DFOB 'S$OUPM'
	.IF S$TEXT <> ""	.GOTO 'S$TTYP'
	.IF S$INOP = "BA"	.GOSUB SETRDX D$DFIB 'S$INPM'
	.IF S$TEXT <> ""	.GOTO 'S$TTYP'
	'S$TRAC'	.GOTO OPNSHO
	.GOTO EXIT
	.SETN D$DFIB 2.			! Default input radix for "BASE".
	.SETN D$DFOB 2.			! Default output radix for "BASE".
.OPNSHO:; S$DSOP =
	; "'S$DSOP'"
	.GOTO EXIT
.OPNTRA:.SETS S$TRAC ""
	.GOTO EXIT

.CLCDSP:.SETS S$VAR "X"
	.PARSE S$CALC "=" S$CALC S$TEMP
	.IF S$TEMP = ""	.GOTO CLCDSG
	.SETS S$VAR S$CALC
	.SETS S$CALC S$TEMP
	.SETS S$TEXT "-- Invalid variable name '''S$VAR'''."
	.TEST S$VAR
	.IF <STRLEN> > 6	.GOTO 'S$TTYP'
	.IFF <ALPHAN>		.GOTO 'S$TTYP'
.CLCDSG:.SETN <ERRCTL> 3
	.ONERR CLCERR
	.GOTO CLC'S$INOP'

.CLCBI:	.IF S$INPM <> ""	.GOTO CLCBA
	.SETN D$BASE 2.
	.GOTO CLCBAX

.CLCHE:	.SETN D$BASE 16.
	.GOTO CLCBAX

.CLCBA:	.IF S$INPM = ""	.SETS S$INPM "'D$DFIB'"
	.TEST S$INPM
	.IFF <NUMBER>		.GOTO CLCIVB
	.SETN D$BASE 'S$INPM'.
	.TEST S$BASE
	.IF D$BASE > <STRLEN>	.GOTO CLCIVB
	.IF D$BASE = 10.	.GOTO CLCDE
	.IF D$BASE = 8.		.GOTO CLCOC
.CLCBAX:.DISABLE DECIMAL
	.SETN X 0
.CLCBAL:
	.SETN 'S$VAR' X
	.IF S$CALC = ""	.GOTO DSP'S$OUOP'
	.SETS S$TEMP S$CALC[1:1]
	.SETS S$CALC S$CALC[2:*]
	.TEST S$BASE S$TEMP
	.IF <STRLEN> = 0 .OR .IF <STRLEN> > D$BASE	.GOTO CLCBAX
	.SETN X X*D$BASE+<STRLEN>-1
	.GOTO CLCBAL
.CLCBAX:.SETS S$SUFX "  --  Conversion stopped at '''S$TEMP'''."
	.GOTO DSP'S$OUOP'

.CLCDE:	.ENABLE DECIMAL
	.SETN X 'S$CALC'
	.SETN 'S$VAR' X
	.GOTO DSP'S$OUOP'

.CLCOC:	.DISABLE DECIMAL
	.SETN X 'S$CALC'
	.SETN 'S$VAR' X
	.GOTO DSP'S$OUOP'

.CLCRA:	.DISABLE DECIMAL
	.SETN X 0
	.SETS S$CALC S$CALC[1:3]
.CLCR5L:
	.SETN 'S$VAR' X
	.IF S$CALC = ""	.GOTO DSP'S$OUOP'
	.SETS S$TEMP S$CALC[1:1]
	.SETS S$CALC S$CALC[2:*]
	.TEST S$RD50 S$TEMP
	.SETN D$CHR1 <STRLEN>
	.IF D$CHR1 = 0	.SETN D$CHR1 36
	.SETN X X*50+D$CHR1-1
	.GOTO CLCR5L

.CLCAS:	.DISABLE DECIMAL
	.SETN X 'S$CALC%V'
	.SETN 'S$VAR' X
	.SETS S$CALC S$CALC[2:*]
	.IF S$CALC <> ""	.SETN X 'S$CALC%V'*400+X
	.GOTO DSP'S$OUOP'

.CLCERR:.SETS S$TEXT "-- Syntax error. Command ignored."
	.GOTO 'S$TTYP'

.CLCIV:	.SETS S$TEXT "-- Invalid data type '''S$TEXT'''."
	.GOTO 'S$TTYP'

.CLCIVB:.SETS S$TEXT "-- Invalid base '''S$INPM'''."
	.GOTO 'S$TTYP'


.DSPBI:	.IF S$OUPM <> ""	.GOTO DSPBA
	.SETN D$BASE 2.
	.GOTO DSPBAX

.DSPHE:	.SETN D$BASE 16.
	.GOTO DSPBAX

.DSPBA:	.IF S$OUPM = ""	.SETS S$OUPM "'D$DFOB'"
	.TEST S$OUPM
	.IFF <NUMBER>	.GOTO DSPIVB
	.SETN D$BASE 'S$OUPM'.
	.TEST S$BASE
	.IF D$BASE > <STRLEN>	.GOTO DSPIVB
	.IF D$BASE = 10.	.GOTO DSPDE
	.IF D$BASE = 8.		.GOTO DSPOC
.DSPBAX:.SETS S$TEXT ""
	.SETN D$TMP X
.DSPBAL:
	.SETN D$TMP1 D$TMP
	.SETN D$TMP D$TMP/D$BASE
	.SETN D$TMP1 D$TMP1-(D$TMP*D$BASE)+1
	.SETS S$TEXT S$BASE[D$TMP1:D$TMP1]+S$TEXT
	.IF D$TMP <> 0	.GOTO DSPBAL
	.SETS S$TEXT "= 'S$TEXT'"
	.GOTO 'S$TTYP'

.DSPDE:	.SETS S$TEXT "= 'X%SD'"
	.GOTO 'S$TTYP'

.DSPOC:	.SETS S$TEXT "= 'X%MO'"
	.GOTO 'S$TTYP'

.DSPRA:	.SETS S$TEXT "= 'X%X'"
	.GOTO 'S$TTYP'

.DSPAS:	.SETN D$CHR2 X/256.
	.SETN D$CHR1 X-(D$CHR2*256.)
	.SETS S$TEXT "= ''"
	.IF D$CHR1 > 0	.SETS S$TEXT S$TEXT+"'D$CHR1%V'"
	.SETS S$TEXT S$TEXT+"'',''"
	.IF D$CHR2 > 0	.SETS S$TEXT S$TEXT+"'D$CHR2%V'"
	.SETS S$TEXT S$TEXT+"''"
	.GOTO 'S$TTYP'

.DSPIV:	.SETS S$TEXT "-- Invalid display type '''S$TEXT'''."
	.GOTO 'S$TTYP'

.DSPIVB:.SETS S$TEXT "-- Invalid base '''S$OUPM'''."
	.GOTO 'S$TTYP'

.VT100:	;'S$ESC'[A'S$ESC'['D$HSPA%D'C 'S$TEXT''S$SUFX'
	.GOTO EXIT

.VT52:	.;
.VT50:	.SETS S$TEMP "'S$ESC'A"+S$V50H[1:D$HSPA*2]
	;'S$TEMP' 'S$TEXT''S$SUFX'
	.GOTO EXIT

.HCPY:	.SETS S$TEMP S$BLNK[1:D$HSPA]
	;'S$TEMP' 'S$TEXT''S$SUFX'
	;
	.GOTO EXIT


.EXIT:
	.IFT L$PRMP	.GOTO PROMPT
	.EXIT

.ANLOPT:
	.BEGIN
	.PARSE COMMAN " " S$ANV1 S$ANP1 S$ANS1
	.PARSE 'S$ANV1' ":" 'S$ANV1' S$ANS1
	.IF S$ANP1 <> ""	.SETS 'S$ANP1' "'S$ANS1'"
	.SETS S$ANS1 "/"+'S$ANV1'
	.IF 'S$ANV1' = ""	.SETS S$ANS1 "/'S$OPDF'"
	.IF S$ANS1 = "/"	.GOTO ANLSYN
	.TEST S$DSYN S$ANS1
	.IF <STRLEN> = 0	.GOTO ANLSYN
	.SETS S$ANS1 S$DSYN[<STRLEN>+1:*]
	.PARSE S$ANS1 ":/" S$ANS2 S$ANS1 S$ANS2
	.SETS S$ANS1 "/"+S$ANS1
.ANLSYN:.TEST S$DSOP S$ANS1
	.IF <STRLEN> > 0	.GOTO ANLCOP
	.SETS S$TEXT 'S$ANV1'
	.SETS S$ANS1 "IV"
	.GOTO ANLXIT
.ANLCOP:.SETS S$ANS1 S$DSOP[<STRLEN>+1:*]
	.PARSE S$ANS1 ":/" S$ANS1 S$OPDF S$ANS2
	.SETS S$OPDF S$OPDF[1:2]
.ANLXIT:.SETS 'S$ANV1' S$ANS1[1:2]
	'S$TRAC';	'S$ANV1' = "'S$ANS1'"
	'S$TRAC';	S$OPDF = "'S$OPDF'"
	.END	
	.RETURN


.SETRDX:
	.BEGIN
	.SETS S$TEXT ""			! Assume success.
	.PARSE COMMAN " " S$ANV1 S$ANS1	! Get the output var and the string.
	.TEST S$ANS1			! Test string.
	.IFF <NUMBER>	.GOTO SETRDB	! If non-numeric, error.
	.SETN D$ANS1 'S$ANS1'.		! Convert to number.
	.IF D$ANS1 < 2	.GOTO SETRDB	! If less than 2, error.
	.IF D$ANS1 > 16. .GOTO SETRDB	! If greater than 16, error.
	.SETN 'S$ANV1' D$ANS1		! Success. Store the number
	.GOTO SETRDE			!    and exit.
.SETRDB:.SETS S$TEXT "-- '''S$ANS1''' is not a valid radix."
.SETRDE:.END
	.RETURN


.BADSYS:; Error - System does not support this command file.
	;	  You need RSX-11M+ V2.0 (at least), or
	;	  RSX-11M V4.0 (at least) to run this file.
