* * * FIND VARIABLE (STRING OR SUBSTRING OR NUMBER OR MATRIX ELE * NUMBER OR MATRIX ELEMENT CASE: * HL POINTS TO VALUE * Z CLEARED * STRING OR SUBSTRING CASE: * STRING MAX SIZE RETURNED IN STRMX GLOBAL * LOGICAL LENGTH RETURNED IN STRLG AND DE * BASE ADDRESS OF STRING RETURNED IN STRBA AND HL * SYM.TAB. PTR TO LOGICAL LENGTH FIELD RETURNED IN BC * CARRY SET IFF IT IS A SUBSTRING * Z SET TO INDICATE THAT VAR FOUND A STRING OR SUBSTRING * * VAR CALL NAME JC BSERR * VAR0 CALL SNAME CHECK IF STRING NAME JNC VAR2 GO PROCESS STRING CASE * MOV A,M SNAME RETURNS TXA CPI LPARRW JZ VAR11 TEST IF SUBSCRIPTED * * MUST BE SCALAR VARIABLE * CALL STLK RETURNS ENTRY ADDRESS IN HL JNC VAR13 LXI D,FPSIZ CALL ASTA1 JMP VAR13 * * MUST BE SUBSCRIPTED * VAR11 INX H EAT THE '(' SHLD TXA MVI A,MTYPE ORA C MOV C,A SET TYPE TO MATRIX CALL STLK PUSH H SYMBOL TABLE PTR TO MAX SIZE FIELD CC DIMM0 DEFAULT DIMENSION MATRIX POP H SYMTAB PTR LXI D,0 PUSH D INITIAL LOCATOR INX H INCREMENT SYMTAB PTR TO FIRST DIMENSION TABLE ENTR INX H PUSH H DIMENSION TABLE PTR * VAR12 CALL PFIXE JZ OBERR MUST BE > 0 DCX D POP H DIMTAB CALL DCMP SEE IF INDEX GREATER THAN DIMENSION SIZE JNC OBERR XTHL . LOCATOR TO HL, DIMTAB TO STACK DAD D INDEX PLUS LOCATOR TO HL XCHG . INDEX PLUS LOCATOR TO DE POP H DIMTAB TO HL INX H ADVANCE TO INX H NEXT DIMENSION SIZE (OR MARKER) MOV C,M LOW ORDER BYTE OF NEXT DIM SIZE INX H MOV B,M HIGH ORDER BYTE OF NEXT DIM SIZE PUSH H DIMTAB PTR TO LAST BYTE OF ENTRY MOV A,B ORA C JZ VAR14 JUMP IF THIS SHOULD BE LAST DIMENSION CALL IMUL MULTIPLY NEXT DIMENSION TIMES CURRENT LOCATOR XTHL . NEW LOCATOR TO STACK, DIMTAB PTR TO HL DCX H MAKE POINT TO BEGINNING OF ENTRY IN DIMTAB PUSH H MVI B,',' CALL EATC SYNTAX ERROR IF NOT ANOTHER ARG JMP VAR12 * * COME HERE WHEN LOCATOR IS IN D AND DIMTAB PTR ON STACK * VAR14 CALL EATRP POP H DIMENSION TABLE PTR (SHOULD POINT TO MARKER) INX H MVI C,FPSIZ NUMBER OF TIMES FOR REPEATED ADD * RADD DAD D DCR C JNZ RADD * VAR13 ORI 1 CLEAR CARRY, SET NON-ZERO LXI D,FPSIZ-1 DAD D RET * * STRING OR SUBSTRING CASE * VAR2 CALL STLK PUSH H SYMTAB PTR TO MAX LXI D,10 CC DIMST CREATE DEFAULT STRING IF DOESN'T EXIST POP H SYMTAB PTR CALL DLOAD XCHG SHLD STRMX XCHG PUSH H SYMTAB PTR TO LG CALL DLOAD SHLD STRBA XCHG SHLD STRLG * MVI A,LPARRW CALL SCANC CMC JNC VAR6 GO RETURN VALUES FOR STRING VARIABLE CASE * LHLD STRMX PUSH H LHLD STRLG PUSH H LHLD STRBA PUSH H CALL PFIXE POP H SHLD STRBA POP H SHLD STRLG POP H SHLD STRMX JZ OBERR * LHLD STRLG CALL HDCMP JC OBERR LHLD STRBA DCX H DAD D SHLD STRBA PUSH D FIRST INDEX * CALL SCOMA JC VAR5 * LHLD STRMX PUSH H LHLD STRLG PUSH H LHLD STRBA PUSH H CALL PFIXE POP H SHLD STRBA POP H SHLD STRLG POP H SHLD STRMX JZ OBERR LHLD STRLG CALL HDCMP JC OBERR XCHG SHLD STRLG * VAR5 CALL EATRP POP D FIRST INDEX LHLD STRLG CALL DSUB JM OBERR WE HAVE SUBTRACTED FIRST INDEX FROM SECOND INX H ADD 1 TO GET EXACT LENGTH SHLD STRLG SHLD STRMX STC * VAR6 POP B LHLD STRLG XCHG LHLD STRBA MVI A,1 DCR A SET Z FLAG WITHOUT AFFECTING CARRY RET * * * SYMBOL TABLE LOOKUP * BC CONTAIN NAME AND TYPE * IF NOT FOUND THEN CREATE ENTRY AND SET CARRY * HL HAS ADDRESS AFTER POINTER ON RETURN * IF ENTRY CREATED THEN STNBA GETS BASE ADDR OF NEW ENTRY * AND STNPTR GETS ADDR OF POINTER TO NEW ENTRY * * STLK MOV A,B COMPUTE CHAIN POINTER ADDR SUI 'A' ADD A LHLD EOFA INX H ADD L MOV L,A JNC STLK1 INR H HL CONTAINS CHAIN POINTER * * LOOKUP LOOP, FOLLOW CHAIN * STLK1 MOV E,M FOR H INX H MOV D,M THEN L DCX H DE POINTS TO NEXT, HL POINTS TO THIS XCHG . HL POINTS TO NEXT, DE POINTS TO THIS * MOV A,H ORA L JZ STLK2 JMP IF END OF CHAIN (POINTER TO NEXT IS ZERO) * MOV A,M GET 2ND CHAR (0 MEANS NO 2ND CHAR) INX H PASS 2ND CHAR ANI -1-COMVD DONT CARE ABOUT COMMON FLAG AT THIS POINT CMP C SAME? JNZ STLK1 JMP IF ENTRY NOT THE ONE * INX H PASS POINTER TO NEXT SO HL WILL... INX H POINT TO THE DATA IN THIS VAR RET . CARRY IS CLEAR * * CREATE NEW ENTRY * STLK2 PUSH D POINTER TO LAST ENTRY LXI H,3 CALL ASTAB MAKE ROOM FOR NEW ENTRY SHLD STNBA ADDRESS OF NEW ENTRY (FOR UNDF AT ERROR) XCHG . TO DE POP H ADDR OF LAST ENTRY (ITS FORE POINTER) SHLD STNPTR ADDRESS OF LAST FORE POINTER UPDATED (ERROR PROC) CALL DSTOR MAKE LAST ENTRY POINT TO NEW ONE XCHG . DE (ADDR OF NEW ENTRY) TO HL MOV M,C SAVE 2ND CHAR OF NAME INX H PASS 2ND CHAR INX H PASS NEW ENTRY'S FORE POINTER (ZERO NOW) INX H MVI A,1 STA UNDEF IN CASE OF ERROR, SO ERROR LOGIC CAN UN-DEFINE STC . A VAR WAS JUST DEFINED (C=1) RET * * * GETS FP CONSTANT FROM TEXT * PUSHES VALUE ON ARG STACK * AND SETS ARGF - SETS CARRY IFF NOT FOUND * * CONST LHLD TXA XCHG . POINTER TO CONSTANT IS TXA (INTO DE) LXI H,FPSINK CALL FPIN RC DCX D XCHG SHLD TXA NOW POINTS TO TERMINATOR LXI H,FPSIN JMP PSHAS SETS ARGF, CLEARS CARRY AND RETURNS * * * * GET STRING CONSTANT FROM TEXT * ACC=0 MEANS " IS TERMINATOR * ACC#0 MEANS ACC IS TERMINATOR * RETURNS STRING DESCRIPTION A LA VAR * SETS CARRY WITH TXA UNCHANGED IF NO STRING CONST FOUND * * SCONS CPI '"' JZ SCON1 ORA A JNZ SCON2 MVI A,'"' SCON1 CALL SCANC RC * SCON2 LHLD TXA SHLD STRBA LXI D,0 MOV B,A * SCON3 MOV A,M INX H CMP B JZ SCON4 CPI CR INX D JNZ SCON3 JMP BSERR * SCON4 SHLD TXA LHLD STRBA RET * * CERTAIN STATEMNTS MAY NOT APPEAR WITHIN IF STATEMENTS, OR * MAY NOT BE EXECUTED IN THE DIRECT MODE * DIRT0 LDA IFTERM CPI CR JNZ CSERR *FALL THRU TO DIRT * * DIRECT STATEMENT CHECKING ROUTINES * DIRT LDA DIRF ORA A RZ JMP DIERR * * SUBTRACT DE FROM HL * DSUB MOV A,L SUB E MOV L,A MOV A,H SBB D MOV H,A RET * * * * STRING PROCESSOR PARAMETERS * STRBA DS 2 CURRENT STRING BASE ADDRESS STRLG DS 2 CURRENT STRING LENGTH STRMX DS 2 CURRENT STRING MAXIMUM DIMENTION * * SYMBOL TABLE STUFF * STA DS 2 SYMBOL TABLE FREE POINTER STNPTR DS 2 ADDR OF POINTER TO LAST SYMTAB ENTRY CREATED STNBA DS 2 BASE ADDR OF LAST SYMTAB ENTRY CREATED * *