This file contains four keywords,EL,ELSTR,ISTR$ and MDIM.
The way the ENDLINE statement of the 71B works has always irritated me.
It forces the number of characters recognised according to its own rules.
Now EL and ELSTR allow me to control the string of three characters and
how many characters are recognised independently.
As the code has been written, ELSTR [<CHR$(n1)&CHR$(n2)&CHR$(n3)>] has the
default string specified by n1=13 and n2=n3=10 (this could be altered, of
course). Only a string of length 3 is permitted when the statement's parameter
is included.
EL is a function which fixes the Endline string at 0,2 or 3 characters, given
the numeric parameter values 0,1 or 2. With the default string, this means
Endline suppressed for 0, one carriage return and one line feed for 1 and
one CR and 2 LF's for 2; thus 2 gives double spacing on the THINKJET, 1 gives
single spacing while 0 can be used prior to employing raster graphics. The
function returns the previous value of the parameter.
A program could thus save the endline length ( A=EL(2) ) while setting double
space, then, at the end, restore the original length ( A=EL(A) ).
ISTR$ sets STD display mode, executes the STR$ function, then restores the
original display mode in force on entry. Integers are converted 'clean',
with no decimal points or trailing zeros - e.g. X(3,4), not X(3.00,4.00).
MDIM will be of value to users who do not have a MATH ROM, while providing
information on string arrays. It replaces both LBND and UBND. It is a function
of two parameters. The first can be a string array, a matrix or a vector.
The second is numeric and defines the information sought. For a value of 0,
it returns the lower bound of the array, i.e. what option base was in force
when the array was created. For a value of 1, the output is the upper bound
on the number of rows. When the value is 2, the number of columns is returned
for a matrix, 0 is returned for vectors, and the maximum length of the string
is output for string arrays.
Items on the MATH STACK are of two kinds. There are binary coded decimal(BCD)
numbers and there are representatives of other things. For simple strings,
these are headers. For arrays, we have an eight byte dope vector which
contains the information extracted by MDIM. (see also IDS I)


       LEX    'MISCLEX1'      * MISCELLANEOUS KEYWORDS
       ID     #EC
       MSG    0
       POLL   0
STRGCK EQU    #036BA          * VALID STRING? CHECK
EOLCK  EQU    #02A7E          * END OF LINE CHECK
RESPTR EQU    #03172          * RESET POINTERS AFTER PARSE
DROPDC EQU    #05470          * FLEXIBLE DECOMPILE ROUTINE
POP1S  EQU    #0BD38          * POP 1 STRING
EXPEXC EQU    #0F186          * EVALUATE EXPRESSION, SET D1 TO MATH STACK
EOLSTR EQU    #2F95B          * ADDRESS OF ENDLINE STRING
NXTSTM EQU    #08A48          * EXIT FROM STATEMENTS
RNDAHX EQU    #136CB          * POP, ROUND, TEST NUMBER, CONVERT TO HEX IN A(A)
RDATTY EQU    #17CC6          * DATA TYPE ERROR EXIT
ARGERR EQU    #0BF19          * INVALID ARGUMENT ERROR EXIT
EOLLEN EQU    #2F95A          * ADDRESS OF ENDLINE STRING LENGTH NIBBLE
FNRTN1 EQU    #0F216          * FUNCTION RETURN
A-MULT EQU    #1B349          * MULTIPLY TWO HEX NUMBERS
HDFLT  EQU    #1B31B          * FLOAT A HEX NUMBER
EXPR   EQU    #0F23C          * FUNCTION RETURN
STR$SB EQU    #18149          * INTERNAL VERSION OF STR$
DSPFLG EQU    #2F6DC          * ADDRESS OF DISPLAY FORMAT NIBBLE
MEMBER EQU    #1B098          * TEST A BYTE
       ENTRY  ENTER
       CHAR   #D              * STATEMENT CAN BE USED ANYWHERE
       ENTRY  LABEL1
       CHAR   #F              * FUNCTION
       ENTRY  LABEL
       CHAR   #F              * FUNCTION
       ENTRY  entry
       CHAR   #F              * FUNCTION
       KEY    'ELSTR'         * SYNTAX: ELSTR [<CHR$(N1)&CHR$(N2)&CHR$(N3)>]
       TOKEN  8
       KEY    'EL'            * SYNTAX: EL(n), 0<=n<=2
       TOKEN  9
       KEY    'ISTR$'         * SYNTAX: AS FOR STR$
       TOKEN  10
       KEY    'MDIM'          * SYNTAX: MDIM(X,n) OR MDIM(X$,n), 0<=n<=2
       TOKEN  11              * WHERE X IS MATRIX OR VECTOR, X$ IS STR. ARRAY
       ENDTXT
ELSTRp  GOSBVL EOLCK          * PARSE ELSTR : IS THERE A PARAMETER?
        GOC    resptr         * NO
        GOSBVL RESPTR         * YES, RESET POINTERS
        GOSBVL STRGCK         * CHECK THAT WE HAVE A VALID STRING
resptr  GOVLNG RESPTR
ELSTRd  GOVLNG DROPDC         * DECOMPILE
        REL(5) ELSTRd
        REL(5) ELSTRp
ENTER   A=DAT0 B              * IS THERE A PARAMETER? THIS PART IS TAKEN FROM
        LCHEX  F0             * IDS 3 CODE FOR ENDLINE WHERE THE PARAMETER
        ?A<C   B              * IS OPTIONAL
        GOYES  EL1            * THERE IS, SO BRANCH
        D1=(5) EOLSTR         * THERE ISN'T, SO USE DEFAULT
        LCHEX  0A0A0D         * LOAD DEFAULT STRING
        P=     5
        DAT1=C WP             * WRITE THE STRING TO EOLSTR
        GONC   nxtstm         * B.E.T.
EL1     GOSBVL EXPEXC         * EVALUATE EXPRESSION AND SET D1 TO MATH STACK
        GOSBVL POP1S
        C=0    W
        LC(1)  6
        ?A=C   A              * IS STR. LENGTH 6 NIBBLES?
        GOYES  OK
        GOVLNG ARGERR
OK      AD0EX                 * SAVE D0
        D0=(5) EOLSTR         * SET D0 TO EOLSTR
        P=     5
        C=DAT1 WP             * COPY THE STRING FROM THE MATH STACK TO C
        DAT0=C WP             * COPY THE STRING FROM C TO EOLSTR
        AD0EX                 * RESTORE D0
nxtstm  GOVLNG NXTSTM         * EXIT
        NIBHEX 811            * ONE OBLIGATORY NUMERIC PARAMETER FOR
 LABEL1 CD0EX                 * THE FUNCTION EL
        R3=C                  * SAVE D0 IN R3
        D0=(5) EOLLEN         * SET D0 TO EOLLEN
        A=0    W              * CLEAR A
        A=DAT0 1              * COPY DISPLAY FORMAT NIBBLE TO A(0)
        ?A=0   W              * 0 RETURNS 0
        GOYES  LABEL2
        A=A-1  A              * CONVERT 4=>1,6=>2
        A=A-1  A
        ASRB                  * THIS DIVIDES BY 2
LABEL2  R2=A                  * SAVE OLD VALUE IN R2
        GOSBVL RNDAHX
        GONC   Argerr         * NO NEGATIVES PLEASE
        P=     0
        LC(1)  #2
        ?A>C   P              * ARGUMENT NOT >2, PLEASE
        GOYES  Argerr
        LC(1)  #5
        C=C-A  A              * CONVERT ARG. TO No OF NIBBLES
        GOSBVL A-MULT
        DAT0=A 1              * WRITE RESULT TO EOLLEN
        C=R3
        CD0EX                 * RESTORE D0
        A=R2                  * PREPARE OLD VALUE FOR OUTPUT
        GOSBVL HDFLT
        ACEX   W
        GOVLNG FNRTN1         * SEND OUT OLD VALUE
Argerr  GOVLNG ARGERR
        NIBHEX 811            * THIS IS ISTR$
LABEL   CD0EX                 * SAVE D0
        R3=C                  * IN R3
        D0=(5) DSPFLG         * ADDRESS OF NIBBLE TO SAVE AND CHANGE
        C=0    W
        C=DAT0 S              * PICK UP NIBBLE IN C(S)
        R4=C                  * SAVE IN R4
        C=0    W
        P=     0
        LC(1)  #8             * THIS VALUE WILL SET STD DISPLAY
        DAT0=C 1              * WRITE IT TO DSPFLG
        A=0    W
        GOSBVL STR$SB         * CONVERT!
        C=R4                  * RECOVER ORIGINAL NIBBLE
        DAT0=C S              * RESTORE IT
        C=0    W
        C=R3                  * RECOVER D0
        CD0EX                 * RESTORE D0
        GOVLNG EXPR           * FUNCTION EXIT WHEN ITEM IS ALREADY ON STACK
        NIBHEX 8E22           * TWO PARS.:1st STR OR NUMERIC ARRAY, 2nd NUMERIC
entry   GOSBVL RNDAHX
        GONC   argerr
        D1=D1+ 16             * SHIFT D1 PAST NUMERIC
        R1=A                  * SAVE NUMERIC IN R1
        A=DAT1 B              * COPY DATA TYPE BYTE TO A(B)
        P=     0
        LCHEX  #1A1B1C1D1E    * DATA TYPE BYTES FOR VECTORS
        P=     9
        GOSBVL MEMBER         * IS OUR BYTE ONE OF THESE?
        GONC   start1         * IF SO, BRANCH
        LCHEX  #2A2B2C2D2E1F  * DATA TYPE BYTES FOR MATRICES+ F1 FOR STR.ARRAYS
        P=     11
        GOSBVL MEMBER         * IS IT ONE OF THESE?
        GONC   start2         * YES, BRANCH
        GOVLNG RDATTY         * NO, DATA TYPE ERROR
start1  ST=1   4              * SET ST4 FOR VECTORS
        GOTO   start
argerr  GOVLNG ARGERR
start2  ST=0   4              * CLEAR ST4 OTHERWISE
start   A=R1                  * RESTORE A TO GET OUR NUMERIC PAR BACK
        C=0    W
        ?A=C   A              * WAS IT 0?
        GOYES  base           * LOWER BOUND WAS WANTED
        C=C+1  A
        ?A=C   A              * WAS IT 1?
        GOYES  dim1           * No OF ROWS WAS WANTED
        C=C+1  A
        ?A>C   A              * ARG >2?
        GOYES  argerr         * INVALID ARGUMENT, OTHERWISE DIM2 WAS WANTED
dim2    ?ST=1  4              * DO WE HAVE A VECTOR?
        GOYES  vector
        GOSUB  saveD1         * SELF EXPLANATORY
        D1=D1+ 3              * NIBS 3-6 HOLD DIM2 (OR MAXLEN)
        A=DAT1 4              * COPY TO A
        GOTO   out            * OUTPUT
base    GOSUB  saveD1
        D1=D1+ 2              * NIB 2 HOLDS LOWER BOUND
        A=DAT1 1              * COPY TO A
out     C=R0                  * OUTPUT ROUTINE
        CD1EX
out1    GOSBVL HDFLT          * D1 WAS OK FROM vector
        D1=D1- 16             * SHIFT D1 BACK FOR OUTPUT
        ACEX   W
        GOVLNG FNRTN1         * SEND RESULT OUT
saveD1  CD1EX                 * ROUTINE TO SAVE D1
        R0=C                  * IN R0
        CD1EX
        RTN
dim1    GOSUB  saveD1
        D1=D1+ 7              * NIBS 7-10 HOLD DIM1 (No OF ROWS)
        A=DAT1 4              * COPY TO A
        GOTO   out
vector  A=0    W
        GOTO   out1           * OUTPUT 0 FOR DIM2 OF VECTOR
        END