/ MATHOLE Math hole routines / / --------------- EDIT HISTORY ------------------- / / 003 KMD 09-Sep-85 Move PELINE (Print Error LINE) routine out of / LEXASC for more space to deal with MN Currency Smb / 002 RCME 07-Aug-85 Squish MNC deads into 8-bit chars for LP (ppKMD) / 001 RCME 24-Jun-85 Enable use of multinational currency symbols / / This file contains the blasted routines for the MATH module. It is / assembled with the TMATH, LEXASC, and BCDASC routines. / RELOC FIELD 6 *200 RELOC MATHOL / /GET_FieLd_Name: /begin / initialization / set Field_Name_CHaRacter_Count = - (MAXimum_Field_Name_Length + 1) / set Field_Name_CHaracter_Count_with_Deads = - (MAXFNL +1) / / posit / | call LEXic_ReaD_CHARacter / | if [FoRMula_CHaRacter neq ":"] / | ERRor_NFN ("Nonnumeric field name in formula.") / | quit posit / | repeat / | | incrament Field_Name_CHar_Count_with_Deads / | | if [Field_Name_CHar_Count_with_Deads < MAXimum_Field_Name_Length] / | | increment ToKen_VaLue_Buffer_Pointer / | | install character in TOKen_VaLue_Buffer / | | if [DEAD_KEY_sequence_flag = 0] / | | increment Field_Name_CHaRacter_Count / | | if [Field_Name_CHaRacter_Count > MAXimum_Field_Name_Length] / | | ERRor_LOF ("Length of field name is greater than 30 characters.") / | | quit posit / | | set AC = 0 (skip all special characters except space, tab, and ) / | | call LEXic_ReaD_CHARacter / | | if [FoRMula_CHaRacter = "new_line"] / | | ERRor_FTW ("Formula terminated within a field name.") / | | quit posit / | | if [FoRMula_CHaRacter = "<"] / | | ERRor_UB ("Unmatched angle brackets") / | | quit posit / | until [FoRMula_CHaRacter = ">"] / | / | set TOKen_VALue = number of characters in field name / | terminate buffer (set bit0 in addr. of last word in ToKen_VaLue_Buffer) / | set AC = OPERANd / | / else (posit) / set TOKen_VALue = error / set AC = ERROR / end_posit / / set TOKEN = AC / / return /end / FLNHOL, XX TAD XNMAXFN / set FNCHRC DCA FNCHRC /d001 DCA DEADKEY / Zero dead key flag just in case TAD FNCHRC / Copy this to the other counter DCA FNCHCD / Field_Name_CHar_Count_with_Deadkeys / JMS I XLEXRDCHAR / read character following "<" of field name. TAD FRMCHR / get character just read TAD XPCOLON / is character = ":"? SZA CLA / skip if: character = ":" JMP RERNFN / error - "Nonnumeric field name in formula." / GETFL1, ISZ FNCHCD / inc Field_Name_CHar_Count_with_Deads TAD FNCHCD / test the result for positive or zero SMA CLA / Is the field name (inc deads) 30 long? JMP GETFL2 / Yes, skip to test printable char length ISZ TKVLBP / No, increment ToKen_VaLue_Buffer_Pointer TAD FRMCHR / Get the character to save DCA I TKVLBP / Install it in TOKen_VaLue_Buffer GETFL2, TAD I XDEADKEY / Test the dead key sequence status SNA CLA / Are we currently processing a dead key? ISZ FNCHRC / No, increment Field_Name_CHaRacter_Count SKP / still less than 30 characters in name. JMP RERLOF / error - "Length of field name is greater / than 30 characters." JMS I XLEXRDCHAR / get another character. TAD FRMCHR / get character just read TAD XNECNWLN / is it a "new_line"? (line_feed) SNA / skip if: not JMP RERFTW / error - "Formula terminated within a field name." GETFL3, TAD XNLANGLE / is character a "<"? SNA / skip if: not JMP RERUB / error - "Unmatched angle brackets." GETFL4, TAD XNRANGLE / is FRMCHR = ">"? SZA CLA / skip if: so JMP GETFL1 / save this character and get another. TAD FNCHCD SMA / Are there more than 30 chars inc deads? AC7777 / Yes, there are only a max of 30 in buf TAD XMAXFNL / set TOKen_VALue = number of characters in field name DCA I XTOKVAL AC4000 / set terminator bit in last word of ToKen_VaLue_Buffer TAD I TKVLBP DCA I TKVLBP / terminate buffer TAD XOPERAN / set AC = OPERANd JMP GETFL7 / leave GETFLN - no errors encounted. everthing a.o.k! / RERFTW, TAD XERRFTW / error - "Formula terminated within a field name." RERLOF, TAD XERRLOF / error - "Length of field name is greater / than 30 characters." RERUB, TAD XERRUB / error - "Unmatched angle brackets." RERNFN, TAD XERRNFN / error - "Nonnumeric field name in formula." DCA I XTOKVAL / set TOKen_VALue = error number / GETFL7, DCA TOKEN / set TOKEN / / CDIMNU / Return to menu field, wence called JMP I FLNHOL / / / / The following are the links for the above, explicitly defined here to prevent / auto generation outside the blast area. XNMAXFN, -MAXFNL-1 XLEXRDCHAR, LEXRDCHAR XPCOLON, -":+200 XDEADKEY, DEADKEY XNECNWLN, -ECNWLN XNLANGLE, ECNWLN-"<+200 XNRANGLE, "<-"> XMAXFNL, MAXFNL+1 XTOKVAL, TOKVAL XOPERAN, OPERAN XERRFTW, ERRFTW-ERRLOF XERRLOF, ERRLOF-ERRUB XERRUB, ERRUB-ERRNFN XERRNFN, ERRNFN /------------ PAGE / This next routine is not infact a maths routine at all. It is /a002 / a List Processing routine called via the maths hook and /a002 / assembled in the maths hole block because there is no more room /a002 / on the disk, or in the List Processing code. /a002 / / SQUISH is a routine which is called from the List Processing numeric /a002 / field value processor. It takes any dead key sequences that /a002 / form MCS characters and squishes them down to an 8 bit char /a002 / that MATH can interpret (possibly) as an MCS currency symbol. /a002 / It returns either the 8 bit value, or 0 if the deadkey is not /a002 / an MCS character. /a002 RELOC *400 RELOC LPHOLE / Runs in List Processing field /a002 SQUHOL, XX / MCS deadkey to 8 bit routine /a002 CDFLP / This definately runs in the LP field /a002 CLA / Clear the 8 bit character store /a002 DCA SQURTN / .... /a002 JMS I XSRBRD / Call the get character routine /a002 TAD SQUM40 / Test for special deadkey introducer /a002 SZA CLA / Is it the correct introducer? /a002 JMP LOOKEN / No, return with clear acc. /a002 JMS I XSRBRD / Get the next character /a002 TAD SQUM40 / Check for a required space /a002 SNA CLA / Is it a required space? /a002 JMP LOOKEN / Yes, so return a zero /a002 JMS I XSRBRD / Get the multinational character /a002 TAD SQU200 / Make it 8 bit /a002 DCA SQURTN / Save it for later /a002 LOOKEN, JMS I XSRBRD / Get the next character /a002 TAD SQUNDO / Test for the end of the deadkey /a002 SZA CLA / Have we an End of Dead? /a002 JMP LOOKEN / No, keep looking /a002 TAD SQURTN / Get the determined value back /a002 CDFMTH / Return via the maths blast hook /a002 CIFMNU / Via the blaster in menu fld /a002 JMP I SQUHOL / .... /a002 SQURTN, 0 / Location in which to store the 8 bit /a002 / Links are listed here to prevent generation by pal outside the blast /a002 SQUM40, -40 XSRBRD, SSRBRD SQU200, 200 SQUNDO, -ECNDOV RELOC /a002 /a003 This routine used to reside in LEXASC but was moved to here to /a003 allow more room in LEXASC for dealing with post-numeric muli-character /a003 currency symbols. (eg. PTS for spain). /A003 It is assembled immidiatly following the previous one so as not /a003 to use too much space in panel. *440 RELOC MATHOL SWIDTH=77 /SCREEN WIDTH (63 DECIMAL) LMARGN=05 /LEFT MARGIN PELINX, CLA TAD I APELINP / INITIALIZE LINE COUNTER from SAVED PARAM /M008 TAD PLMARGN DCA PELIN1 /D003 JMS GETFLD / GET CDI INSTRUCTION /M007 /D003 DCA PELIN5 / STORE THE INSTRUCTION /D007 AC0002 / INITIALIZE READ LINE BUFFER CODE TO / READ FROM BEGINNING OF BUFFER TO / CURRENT POSITION IN BUFFER ONLY / (I.E. - UP TO THE POINT OF AND / INCLUSIVE OF ERROR CHARACTER) JMS I ARDLNBF / JMS UPCURP / UPDATE_CURSOR_POSITION PELIN6, JMS I ALEXRDCHAR / READ A CHARACTER FROM THE BUFFER TAD I AFRMCHR / GET THE CHARACTER SNA / SKIP IF: NOT TERMINATOR (0) JMP PELIN8 / TERMINATOR - SO LET'S TERMINATE TAD MECNWLN / IS IT A ? SNA / SKIP IF: NOT JMP PELI10 / END OF LINE - GO PRINT "^" TAD MECTAB / IS IT A TAB? SZA / SKIP IF: SO /M006 TAD MECSPC / RESTORE ORIGINAL CHAR. TO AC /M006 PELI10, TAD PECSPC / CONVERT TAB OR LINE FEED TO A SPACE DCA PCHAR2 / SAVE CHARACTER IN BUFFER /M006 PELIN9, ISZ PELIN2 / INCREMENT CHARACTER_POSITION_COUNTER JMP PELIN7 / STILL ROOM ON LINE - KEEP GOING JMS UPCURP / NO ROOM LEFT ON LINE - POSITION TO NEXT JMP PELIN9 / GO BUMP CHARACTER_POSITION_COUNTER PELIN7, JMS PCHAR / PRINT THIS CHARACTER ON SCREEN JMP PELIN6 / PRINT MORE PELIN8, TAD PELIN2 / COMPUTE WHERE TO PUT THE "^" TAD SWLM100 TAD PELIN1 DCA PELIN1 JMS POCUR TAD UPARROW DCA PCHAR2 /M006 JMS PCHAR / PRINT "^" / /TJRF CIFMTH /TJRF JMS RTRN1 / REINIT LNEBUF POINTER. NEED TO DO THIS FOR /TJRF / EDITOR MATH. SHOULD NOT EFFECT LP MATH. /TJRF / /TJRF /D003 PELIN5, .-. / CIF CDF RETURN INSTALLED CIFMNU / BACK TO MENU FIELD AS WE WERE BLASTED /A003 JMP I PELINX / RETURN TO CALLER /M003 / PELIN1, 0 / LINE AND COLUMN COUNTER PELIN2, 0 / CHARACTER POSITION COUNTER / / / UPDATE LINE_COUNTER AND POSITION THE CURSOR. THEN INIT. CHARACTER_ / POSITION_COUNTER. UPCURP, XX AC0100 / INCREMENT LINE COUNTER TAD PELIN1 DCA PELIN1 JMS POCUR / POSITION THE CURSOR TAD SWLMM1 / INIT. CHARACTER_POSITION_COUNTER DCA PELIN2 JMP I UPCURP / RETURN / / POCUR, XX / POSTION CURSOR ROUTINE CIFMNU JMS I IOACAL 0 POCUR1 / ADDRESS OF COMMAND STRING PELIN1 / POSITION VALUE JMP I POCUR / RETURN POCUR1, TEXT "!P" / INDIRECT TO GET POSTITION / / PCHAR, XX / PRINT CHARACTER CIFMNU JMS I IOACAL 0 PCHAR1 / ADDRESS OF COMMAND STRING PCHAR2 / ADDRESS OF CHARACTER TO PRINT /M006 JMP I PCHAR / RETURN PCHAR1, TEXT "^A" /M006 PCHAR2, ZBLOCK 2 / ASCII CHARACTER BUFFER /A006 / / / /D003 / / / / LINKS PLACED HERE TO STOP PAL GENERATING THEM AT END OF PAGE ARDLNBF, RDLNBF /ROUTINE ADDRESSES ALEXRDCHAR, LEXRDCHAR AFRMCHR, FRMCHR APELINP, PELINP /PARAMETER ADDRESS MECNWLN, -ECNWLN /CONSTANTS MECTAB, -ECTAB+ECNWLN MECSPC, ECTAB-ECSPC PECSPC, ECSPC SWLM100, SWIDTH-LMARGN+100 UPARROW, "^-200 SWLMM1, -SWIDTH+LMARGN-1 PLMARGN, LMARGN RELOC