Volume 5 -- Issue 4 | January 1985

In This Issue...

- 18-Digit Arithmetic, Part 9
- Symbol Table Source Maker
- Short Single-Byte Hex-to-Decimal Printer

Note about Apple Manuals

We have mentioned before how hard it is to find the Apple technical manuals, but it looks like there is now hope. We read somewhere this week that Apple has arranged for Addison- Wesley to distribute the manuals. If this really comes to pass, we will probably be able to get them for you like any bookstore. Here's hoping!

New Version of 6800/6801/6301 Cross Assembler

We have started the long process of upgrading the various S-C Cross Assemblers, and the first one is now available. Owners of Version 1.0 of the 6800/6801/6301 Cross Assembler and of the Version 2.0 of the S-C Macro Assembler can upgrade to Version 2.0 of the Cross Assembler for $20.

If you have not already upgraded to Version 2.0 of the S-C Macro Assembler (for the 6502 et al), you need to do that first or at the same time. If you already have 6502 Version 2.0, but don't have the older version of the 6800 product, you can go directly there for only $50.

6800 XASM Version 2.0 adds 80-column support (for //e, //c, Videx, and STB-80 users), five new directives, and all the other bells and whistles of our 2.0 products.

New disk price!!

Due to incredible competition, floppy disk prices are falling almost as fast as if they were semiconductors! Check our ad on page three for the current low price.

All material herein is copyrighted by S-C SOFTWARE CORPORATION, all rights reserved. (Apple is a registered trademark of Apple Computer, Inc.)

18-Digit Arithmetic, Part 9 | Bob Sander-Cederlof

Nearing the home stretch, this month I will cover the DP18 PRINT statement. I believe that only leaves INPUT for next month.

Normal Applesoft PRINT has a wide variety of options. PRINT may appear all by itself to print a carriage return, or with one or more expressions. The expressions may be separated by commas or semicolons: both are used to separate the expressions for syntax purposes, but commas also cause a form of tabbing. A final comma or semicolon may be used to suppress the normal carriage return at the end of the printed line. All numeric values are printed in an unformatted style.

We wanted to have additional formatting capabilities in DP18 PRINT. Many users of Applesoft have tried to write money handling programs, agonizing over the contortions necessary to make pretty reports. BASIC on many other micros comes with PRINT USING, which includes a string describing the exact format to use for print a list of items. Applesoft doesn't have PRINT USING (we have graphics instead, and all in a 10K interpreter). DP18 does.

DP18 doesn't have everything though. Here are some things we left out. Commas may be used to separate items in a DP18 PRINT statement, but no tabbing happens. Instead, commas cause carriage returns. DP18 values are so long that comma tabbing seemed useless. You cannot fit two fully extended unformatted values in one 40-column line. Maybe you could say we do tab, all the way to the next line. Anyway, this gives us a useful NEW feature: the ability for one PRINT statement to print on more than one line.

DP18 PRINT can only print DP18 expressions. Normal Applesoft real or integer expressions can be printed by normal Applesoft PRINT, or by converting them to DP18 values using VAL and STR$. Applesoft string expressions can be printed using a DP18 "picture", but not in the simple manner you are used to in normal Applesoft PRINT.

DP18 in its present form supports three different kinds of items in a PRINT statement: DP18 expressions, #WD items, and $PIC items.

The first kind is the easiest to use, and will remind you a lot of Applesoft. Since all you tell DP18 is the expression, it makes up its own mind about the format to use. We call this "unformatted", because it hard to predict how it will look once it is printed. If the absolute value of the number to be printed is within the range from .01 to 999,999,999,999,999,999 (18 digits) it will print as a normal number, with no leading or trailing blanks and no trailing zeroes. If outside that range, it will be printed with an E exponent. Doesn't this remind you of Applesoft? Here are some examples using numbers (bear in mind they could be long complicated DP18 expressions):

          ]&DP:PRINT 1,2,3;4;5
          1
          2
          345
          ]&DP:PRINT .009,.01,999999999999999999
          9E-3
          .01
          999999999999999999
          ]&DP:PRINT 1000000000000000000
          1E+18
          ]

If a PRINT list item begins with the character "#", it is a #WD formatted item. Three things follow the "#" character, separated by commas: a field width, the number of fractional digits, and a DP18 expression. (If you have ever used Fortran, this is going to remind you of the "Fw.d" format.)

          &DP:PRINT #w,d,value

The w and d parameters are Applesoft expressions (or simple constants), and the value is a DP18 expression. The value will be printed right-justified in a field w-characters wide, with d decimal places after the decimal point. Leading blanks will be printed if there is room for any. If the number will not fit in w characters, w asterisks will be printed instead to show you there was an overflow problem. Values are rounded to the required number of decimal places, not just truncated. Here are some examples:

          ]&DP:PRINT #8,3,2.04;#8,3,5,#10,5,3.14159,#3,1,99
             2.040   5.000
             3.14159
          ***
          ]&DP:PRINT #8,4,3.14159,#7,3,3.14159,#6,2,3.14159
            3.1416
            3.142
            3.14

          100 FOR I=0TO5
          110 PRINT I;:&DP:PRINT #10-I,5-I,3.1415926
          120 NEXT
          ]RUN
          0   3.14159
          1   3.1416
          2   3.142
          3   3.14
          4   3.1
          5   3.

The third type of PRINT item begins with a dollar sign. A string constant, variable, or expression follows the dollar sign. If the picture specifies fields for DP18 or string values to be printed in, then the list of values must follow the picture, all separated by commas.

          &DP:PRINT $ picture
          &DP:PRINT $ picture,list

The "picture" is any Applesoft string expression; it is used as the template for formatting the expressions in the optional list. The list may have any number of expressions separated by commas as long as they correspond with the picture. You may even have no expressions at all, which is why I say the list is optional.

The picture consists of a string of characters. There are four basic types of characters used in pictures: commands, literals, numbers, and field descriptions. These are described below.

Any number in the picture makes up a repeat count. The repeat count specifies how many times to repeat the following command or field-description character. If a command is not preceded by a repeat count, a 1 is assumed. Repeat counts may range anywhere from 1 to 255.

The commands which may be included in pictures give you control over the screen and cursor. Some of the commands allow a repeat count to be specified. In the following descriptions, "n" refers to the optional repeat count. If no repeat count is used, n=1.

>     / -- Prints n carriage returns.

>     X -- Prints n spaces.

>     > -- Clear to from the cursor to the end of line.
>          If the next picture character is also ">",
>          clear from the cursor to the end of screen.

>     V -- Performs VTAB n, where n must be from 1 to 24.

>     H -- Performs HTAB n.  [As implemented now, this is
>          probably not compatible with your printer or
>          80-column cards.]

Literals are defined in strings using the apostrophe. Any text you want to print from inside the picture may be included between apostrophes. If you want to include an apostrophe inside a literal, put two apostrophes in a row. If you put a repeat count before the literal, it will be printed n times.

Now here are some examples using repeat counts, commands, and literals.

>     &DP:PRINT $ "VH>>"     (moves the cursor to the top left
>                             corner, and clears the screen.)

>     ]&DP:PRINT $ "'SEPARATE'/'LINES'"
>     SEPARATE
>     LINES
>     ]&DP:PRINT $ "4V10H3'BANG! '"
>     starting at line 4 column 10 prints:
>               BANG! BANG! BANG!

There are two kind of field descriptions: one for telling DP18 how to print numbers and the other for telling how to print strings. Since string descriptors are easier, let's start with them.

A string field descriptor tells DP18 how to print the value of an Applesoft string. There are three different characters used, which tell DP18 whether to left-justify, right-justify, or center the value of the string within the field. Since we are building a "picture", the width of the field is shown by using multiples of the controlling character. The three different controlling characters are:

>     A -- Print the string left justified in the field.

>     R -- Print the string right justified in the field.

>     C -- Print the string centered in the field.

The data to be printed comes from the list of data items which follows the picture. Here are some examples using string descriptors:

         ]A$="ABC"
         ]P$="AAAAAAA'-'RRRRRRR'-'CCCCCCC'-'"
         ]&DP:PRINT $ P$,A$,A$,A$
         ABC    -    ABC-  ABC  -
         aaaaaaa.rrrrrrr.ccccccc.

         ]PRINT $"RRRRR X 5A 'HI' 6C 'BYE'","AB","ABC","XY"
            AB ABC  HI  XY  BYE
         rrrrrxaaaaa..cccccc...

If you mix the A, C, and R control letters in one string field descriptor, the controlling letter will be the last one in the field. If you want to have two fields adjacent to each other, you can separate the descriptors with a space. The space will not become part of the printed output. If a string value is too long to fit in a field, the field will be filled with asterisks instead of the actual data. When you see asterisks where you expected data, the data was too long.

         ]&DP:PRINT$"AAA AAA AAA","AN","EGG","ROLLS"
         AN EGG***

Numeric field descriptors are made up of the characters listed below. The number to be printed is taken from the expression list. The expression corresponding to a numeric field descriptor MUST be a DP18 expression. If it is not a DP18 numeric expression, an error will result. If the number is too large for the field, asterisks will be printed. The number is rounded to the number of decimal places you specify in the descriptor before printing. Trailing zeroes after the decimal point are printed if necessary to fill up the field.

>     + -- Reserves a place for the sign of the number.
>          the sign will be printed in this position
>          even if the number is positive.  The sign
>          may be placed anywhere within or at either
>          end of the number.

>     - -- Also reserves a place for the sign, but the
>          sign will only be printed if it is negative.
>          If the number is positive, the fill character
>          is printed instead.

(If neither + nor - is present in the field descriptor, the sign is printed only if the number is negative. It is printed just to the left of the first significant digit of the number. If you used zero or star fill, this looks ridiculous; therefore be sure to specify the sign position when you use zero or star fill.)

>     # -- Reserves a place for a digit, and selects
>          space fill.  Unused digit positions to the
>          left of the most significant digit will be
>          filled with spaces.

>     * -- Reserves a place for a digit, and selects
>          star fill.  Unused digit positions to the
>          left of the most significant digit will be
>          filled with stars.

>     Z -- Reserves a place for a digit, and selects
>          zero fill.  Unused digit positions to the
>          left of the most significant digit will be
>          filled with zeroes.

>     . -- Reserves a position for the decimal point.
>          The number will be lined up with the decimal
>          point.  If no decimal point is present in
>          the picture, none is printed.  Don't try
>          to put more than one decimal point in one
>          descriptor.

>     , -- Puts a comma in the number.  If the comma
>          would precede all the non-blank characters
>          printed in the field, the comma will not be
>          printed.

If a mixture of #, *, and Z characters are used in field descriptor, the field will be controlled by the last one.

>     ]PRINT$ "'THE ANSWER IS '###,###.##",53156.6378
>     THE ANSWER IS  53,156.64

>     ]PRINT$ "####.##+/####.##-/####.##+/####.##-",
>     12,12.3,-12.34,-12.345
>       12.00+
>       12.30
>       12.34-
>       12.35-

>     ]PRINT$ "5Z.3Z",125.65
>     00125.650

The listing of the DP18 PRINT code follows. There are references to five subroutines printed in previous issues of AAL in lines 1220-1260. The subroutines INPUT.NUM and INPUT.STR which are also referenced will not be printed until next month. Ah, anticipation...!

When the &DP processor encounters a PRINT token, it jumps to DP.PRINT at line 1690. I like simple code, so you can see for yourself that DP.PRINT is only three lines long. All the work is done by PRINT.END (lines 2100-2420) and the routines it calls.

PRINT.END checks for ";" and "," separators between PRINT groups, and branches to the processors for each of the three types of PRINT groups. Lines 2110-2130 check whether we are at the end of the PRINT statement. If so, AS.CROUT prints a carriage return and we leave. If not at the end, a semicolon takes us down to line 2400. There we again check for the end, because a semicolon on the end of the PRINT statement means to omit the final carriage return. A comma takes us to line 2380 where we force-print a carriage return (DP18's kind of tabbing, remember).

Lines 2180-2210 check for the three possible types of PRINT groups: "$" means print with a picture, "#" means print with a w.d format, and anything else means unformatted printing. The #w.d type is handled right here in lines 2230-2360.

Lines 2230-2250, with the help of some code in the Applesoft ROMs, read the next characters from the PRINT statement, calculate whatever expression they represent, and save the result for the field width "w". Lines 2260-2300 do the same for "d". Line 2310 evaluates the DP18 expression for the data value to be printed. Lines 2320-2350 call on the FORMAT.PRINT subroutine discussed some months ago in AAL. After printing, we go back to the top of PRINT.END to allow another PRINT group.

Unformatted printing is handled in lines 1740-2080. Line 1750 evaluates the DP18 expression to be printed. Lines 1760-1800 decide whether to use normal or exponential format, depending on position of the decimal point. The exponential format is handled by QUICK.PRINT and the normal format by FOUT, both printed in an earlier installment. We call FOUT with a format of 40 characters wide and 19 places after the decimal point. Then we print only the significant digits of the resulting string. All leading blanks and trailing zeroes are omitted. If the last character is a trailing decimal point, it too is omitted.

Printing with a picture starts at line 2440. The picture processing code is also used by DP18's INPUT$ statement, and a simple flag is used to tell who called. PRINT sets the INPUT.FLAG = 1, INPUT sets it = 0. INPUT$ and PRINT$ join at line 2470.

The first step in picture processing is to make a working copy of the picture in DP18's PICTURE.BUF. Lines 2490-2510 evaluate the string expression which is the picture. Lines 2520-2650 copy the result into PICTURE.BUF, and place a terminating $00 at the end. Line 2680 initializes a bunch of variables so we can begin to process a field within the picture. (PICTURE.BUF is 256 bytes long. If you want a good project, figure out how to avoid using PICTURE.BUF. We could with more difficulty use the picture right where it is after AS.FRMEVL finishes.)

Lines 2700-2840 control the picture parsing. The basic idea is to scan through the picture executing command characters as we go, converting numbers to repeat counts, and printing literals. When a field descriptor is encountered, it is built up in WBUF to form a template for the conversion. If any of the characters of the descriptor were preceded by a repeat count, those characters will be reduplicated the specified number of times in the WBUF template. After the template is complete, an expression will be evaluated from the PRINT list, and converted into character form. Then those characters will be merged into the template, and the result printed. I got ahead of myself a little, but I wanted to give the overall view first.

PRUS.NEXT calls LOOKUP to process each character of the picture. Lookup searches the table shown in lines 3620-4010. Each entry in the table is three bytes long: the first byte is the character to be matched, and the next two are the address of a subroutine for processing that character. Actually this address is one less than the subroutine address, because it will be pushed onto the stack and branched to with an RTS instruction (see lines 3160-3190 and 3260). The order of the entries in the table is also somewhat significant. There are three groups of entries: the first group includes characters which may be part of a numberic field descriptor; the second, characters for string field descriptors; and the third, command characters. The labels L.EITHER and L.BOTH mark the edges of these three groups.

If LOOKUP matches a character, it checks to see if the character is in the third group (line 2980). If so, we know any field descriptor which may have been building is ended, so lines 3000-3010 clear the FLD.FLAG. If not, lines 3030-3070 start a new field unless we were already in one.

Lines 3080-3140 check if we have finished a field descriptor. We may have, if the matched character was a command character or a field-descriptor character of the opposite type field. So, if the mathced character was a numeric-field character, we call PRT.STR.IF.NEEDED; if it was a string-field character, we call PRT.NUM.IF.NEEDED; and if a command character, we call both of the IF.NEEDED's. The IF.NEEDED routines check if we were building up the corresponding field descriptor. If so, we need to get a value from the PRINT list and print it now, before continuing to process the latest picture character.

Next, LOOKUP branches to the processor for the particular character matched. It sets up the repeat count, if any has been accumulated, in the Y-register. If no repeat count has been accumulated, y is set to 1. The routines are all in lines 4020-5250.

If LOOKUP does not find the picture character in the table, it may be a digit of a repeat count. If so, lines 3280-3450 multiply the existing repeat count by ten and add in the new digit. No check for overflow is done here, so if you write a repeat count of more than 255, it will be taken modulo 256. If you want to check for overflow, insert the check after line 3330:

                    CMP #25
                    BCS RP.OVERFLOW

and put a line after line 3610:

        RP.OVERFLOW JMP AS.OVRFLW

If the character is not even a digit, it is good for nothing but separating field descriptors. Lines 3470-3480 call the two IF.NEEDED routines, in case a field descriptor preceded the non-matching character, and then fall into PRUS.CLEAR to get ready for the next picture character.

If the picture character is Z, #, or * the code at lines 4070-4240 goes to work. There are three different entry points here. A "Z" enters at IP.ZERO, where the A-register is cleared and a $2C opcode is used to skip over the following two bytes of code. You may recall that $2C is the opcode for BIT with a two-byte address. The 6502 acts like the "LDA #' '" is an address for the BIT instruction, and in effect that "hops over" line 4110. (This is a common coding trick in the 6502 world, and is safe except when the second of the two skipped bytes is in the range from $C0 through $C7. In that range you run the risk of flipping some soft switches in the I/O space.)

Lines 4070-4140 store zero, blank, or asterisk in FILL.CHAR and in the template being created in WBUF. These positions in the template will later be replaced with the actual digits of the converted number, unless they precede the most significant digit. The "w" and "d" parameters are also incremented as appropriate, so that we can later call FOUT to create the initial image of the converted number. Lines 4220-4230 loop on the repeat count, storing multiple copies of the fill character if you used a repeat count. We also set the FOUND.NUM flag non-zero, so that the PRT.NUM.IF.NEEDED subroutine will realize the need to print.

The RTS on the end of all the IP... processors takes control back to the middle of PRUS.NEXT, because they are actually just extensions to LOOKUP.

Lines 4290-4310 handle both the + and - picture characters. The character is stored in the template, and also in SIGN.CHAR1 as a flag. We need later to know whether any + or - appeared in the template at all, so the flag will be useful then.

If a decimal point appears in the picture, we store it in the template and also note the fact by setting DECFLG non-zero. A comma is merely stored in the template. See lines 4340-4440 for these two.

Lines 4450-4560 build templates for string field descriptors. The characters A, C, and R and just counted, while saving the lates one in FOUND.CHAR. When the PRT.STR.IF.NEEDED subroutine is called later, all we will need to know is which mode to use (A, C, or R) and how wide the field is.

Lines 4570-4760 print literal strings from the picture. The only tricky part of this is the handling of the closing apostrophe. A single apostrophe signals the end of the literal string, while two apostrophe's in a row mean an apostrophe should be printed within the literal.

Slash or "X" in a picture are handled by lines 4770-4880. Note the use again of the $2C to skip over two bytes of code.

Lines 4900-4960 handle the HTAB command. This is the bare minimum handling, and I can suggest some enhancements you might like to add here. You might want to check and be sure the value is between 1 and 40, giving an error message if out of range. You might want to adapt it to work with your particular printer and 80-column card combinations. Or 132-column Ultra-Term. It's up to you.

Lines 4970-5040 process the VTAB command, and here I do check for a valid line number. Of course, if you have an Ultra-Term set up for more than 24 lines you would want to change the limit in line 5000.

Lines 5050-5180 handle the screen clearing commands. A single ">" character calls MON.CLREOL to clear from the cursor to the end of the current line. If the following character in the picture is also a ">", MON.CLREOS is called instead.

PRT.NUM.IF.NEEDED (lines 5190-5330)is one of the two IF.NEEDED twins. If FOUND.NUM is non-zero, indicating that we have been building a numeric field template, then now is the time to print a number. Unless, of course, we are doing INPUT$ rather than PRINT$. More on that subject next month. PRT.STR.IF.NEEDED (lines 6320-6460) does the same for strings.

When a number needs to be printed, lines 5340-5420 get it ready for conversion. Line 5390 evaluates the next expression from the PRINT list, and it all falls into PRT.NUM.1 at line 5440. INPUT$ has an entry at this same point.

Lines 5450-5490 make room for the sign character if the expression value is negative and a sign reservation character was used in the template. Then W and D are correct for calling FOUT in lines 5500-5530. The remainder of the PRINT.NUM subroutine copies characters from the FOUT.BUF string into the template, and then prints the fleshed-out template. Sounds easier than it really is....

Lines 5540-5690 control the scan through the template in WBUF. Commas in the template are handled right there: if any previous digits have been displayed, or if the fill character is "0" or "*", the comma is left in the template. If no digits have been stored yet and the fill character is blank, the comma is blanked out. It would look kind of silly hanging out in front of a number.

Lines 5700-5720 process a + or - character from the template. The actual code for PRUS.SGN at lines 6110-6310 does the work. If the template character is "+", it gets changed to "-" if the sign of the numeric value is negative. If the template character is "-", it gets changed to blank if the numeric value is positive.

If the template character is a digit place-holder, the next character from FOUT.BUF is examined. If the FOUT.BUF character is a digit, it is stored into the template. If not a digit, it might be a decimal point, a minus sign, or a leading blank. A leading blank gets changed to whatever the fill character is for the current template and stored in the template. A minus sign will be stored if there was no sign-position character in the template. A decimal point will be in the same position in both template and FOUT.BUF, so nothing needs to be done with it.

Since a sign-position character could come at the end of the template, lines 6000-6020 check for that condition.

Finally, lines 6030-6100 print out the composite string from WBUF.

String fields are printed by PRINT.STR, starting at line 6470. Lines 6470-6550 evaluate a string expression from the PRINT list, and set up a pointer to the resulting string value. The entry PRINT.STR.1 is shared with INPUT$. Lines 6570-6620 determine how much longer the field is than the string value. If it is too short, lines 6630-6700 fill the field with stars for an overflow indication.

If the string will fit, lines 6710-6750 store the number of left-over spaces in the field. If we are left-justifying, these will all come at the end; if right-justifying, at the beginning; if centering, half on each end. Lines 6760-6800 branch according to which type of string field we have (A, C, or R). Lines 6810-6840 print leading spaces for type-R fields.

Lines 6850-6910 divide the number of extra spaces in half, so half can be printed before the string and half after. If there were an odd number of extra spaces, the extra extra space will be printed after the string. For example, a four-character string in a nine-character field would be preceded by two blanks and followed by three.

That about winds up the discussion of the DP18 PRINT support. You can add or subtract features from this base, to create the exact configuration you need.

I should give credit to Bobby Deen for the original coding of the PRINT statement routines published this month, and the INPUT stuff next month. I revised them considerably since he wrote them two years ago, but you can still see his marks. Bobby is still pulling in a 4.0 average (highest possible) at Texas A & M, and programming for pay at the same time.

      1000 *SAVE S.DP18 PRINT
      1010 *-------------------------------
      1020 *    APPLESOFT SUBROUTINES
      1030 *-------------------------------
      1040 AS.CROUT     .EQ $DAFB    PRINT CARRIAGE RETURN
      1050 AS.COUT      .EQ $DB5C    PRINT A CHARACTER
      1060 AS.FRMEVL    .EQ $DD7B    EVAL FP FORM. OR STRING
      1070 AS.CHKCOM    .EQ $DEBE    CHECK FOR COMMA
      1080 AS.SYNERR    .EQ $DEC9    SYNTAX ERROR
      1090 AS.ILLERR    .EQ $E199    ILLEGAL QUANTITY ERROR
      1100 AS.FRESTR    .EQ $E5FD   ERR IF NOT STRING,  FREE UP A TEMP STRING
      1110 AS.GTBYTC    .EQ $E6F5    CHRGET, THEN GETBYT
      1120 AS.GETBYT    .EQ $E6F8    GET EXPR AS BYTE IN X
      1130 *--------------------------------
      1140 *   MONITOR SUBROUTINES
      1150 *--------------------------------
      1160 MON.VTABZ    .EQ $FC24
      1170 MON.CLREOS   .EQ $FC42
      1180 MON.CLREOL   .EQ $FC9C
      1190 *--------------------------------
      1200 *      DP SUBROUTINES PRINTED ELSEWHERE
      1210 *--------------------------------
      1220 DP.NEXT.CMD         .EQ $FFFF
      1230 DP.EVALUATE         .EQ $FFFF
      1240 FOUT                .EQ $FFFF
      1250 QUICK.PRINT         .EQ $FFFF
      1260 FORMAT.PRINT        .EQ $FFFF
      1270 INPUT.NUM           .EQ $FFFF
      1280 INPUT.STR           .EQ $FFFF
      1290 *-------------------------------
      1300 *      PAGE ZERO USAGE
      1310 *-------------------------------
      1320 MON.CH       .EQ $24
      1330 MON.CV       .EQ $25
      1340 AS.CHRGET    .EQ $B1
      1350 AS.CHRGOT    .EQ $B7
      1360 P2           .EQ $F9
      1370 P1           .EQ $FD      GP POINTER
      1380 TEMP2        .EQ $FB
      1390 *--------------------------------
      1400 WBUF         .EQ $0200
      1410 *-------------------------------
      1420 *      WORK AREAS FOR DPFP
      1430 *-------------------------------
      1440 DECFLG              .BS 1
      1450 DAC.EXPONENT        .BS 1
      1460 DAC.SIGN            .BS 1
      1470 FOUT.BUF            .BS 41
      1480 STACK.PNTR          .BS 1
      1490 W                   .BS 1
      1500 D                   .BS 1
      1510 SIGN.CHAR1          .BS 1
      1520 INPUT.TYPE          .BS 1
      1530 FOUND.NUM           .BS 1
      1540 FOUND.STR           .BS 1
      1550 STR.LEN             .BS 1
      1560 REPEAT.CNT          .BS 1
      1570 FOUND.LEN           .BS 1
      1580 FOUND.CHAR          .BS 1
      1590 FILL.CHAR           .BS 1
      1600 CHAR                .BS 1
      1610 INPUT.FLAG          .BS 1
      1620 ZERO.CHAR           .BS 1
      1630 FLD.FLAG            .BS 1
      1640 FLD.START           .BS 1
      1650 TEMP3               .BS 2
      1660 INDEX               .BS 1
      1670 PICTURE.BUF         .BS 256
      1680 *-------------------------------
      1690 DP.PRINT
      1700        JSR AS.CHRGET
      1710        JSR PRINT.END
      1720        JMP DP.NEXT.CMD
      1730 *--------------------------------
      1740 DP.UNFORMAT
      1750        JSR DP.EVALUATE   GET EXPRESSION
      1760        LDA DAC.EXPONENT  GET EXPONENT
      1770        CMP #$40+19       MORE THAN 18 DIGITS BEFORE DECPT?
      1780        BCS .5            YES, USE SCIENTIFIC
      1790        CMP #$40-1        LESS THAN .01?
      1800        BCC .5            YES, USE SCIENTIFIC
      1810        LDA #'0
      1820        STA ZERO.CHAR
      1830        LDA #40           ALLOW PLENTY OF WIDTH
      1840        LDY #19           AND DECIMAL PLACES
      1850        JSR FOUT
      1860 *---TRIM TRAILING ZEROES---------
      1870        LDY INDEX         FIND END OF BUFFER
      1880 .1     DEY
      1890        LDA FOUT.BUF-1,Y  TRUNCATE TRAILING ZEROES
      1900        CMP #'0           IS THIS ONE ZERO?
      1910        BEQ .1            ...YES, KEEP TRIMMING
      1920        CMP #'.           OMIT DECIMAL POINT ON INTEGERS
      1930        BEQ .2            ...GOT A DECPT
      1940        INY               TRIM NO MORE...
      1950 .2     LDA #0            MARK END OF MEANINGFUL CHARS
      1960        STA FOUT.BUF-1,Y
      1970        STY INDEX
      1980 *---PRINT WITHOUT LEADING BLANKS-
      1990        TAY               Y=0
      2000 .3     LDA FOUT.BUF,Y
      2010        BEQ PRINT.END
      2020        CMP #$20          BLANK?
      2030        BEQ .4            ...YES, DON'T PRINT
      2040        JSR AS.COUT       ...NO, PRINT IT
      2050 .4     INY
      2060        BNE .3            ...ALWAYS
      2070 *---PRINT WITH EXPONENT----------
      2080 .5     JSR QUICK.PRINT
      2090 *--------------------------------
      2100 PRINT.END
      2110        JSR AS.CHRGOT
      2120        BNE .1            NOT ":" OR EOL
      2130        JMP AS.CROUT
      2140 .1     CMP #';'
      2150        BEQ .3
      2160        CMP #','
      2170        BEQ .2
      2180        CMP #'$      PRINT USING?
      2190        BEQ DP.PRINT.USING
      2200        CMP #'#      PRINT W,D?
      2210        BNE DP.UNFORMAT NO,UNFORMATTED PRINT
      2220 *---PRINT #W,D,VALUE-------------
      2230        JSR AS.GTBYTC     GET W IN X-REG
      2240        TXA
      2250        PHA
      2260        JSR AS.CHKCOM     MUST HAVE COMMA
      2270        JSR AS.GETBYT     GET D IN X-REG
      2280        TXA
      2290        PHA
      2300        JSR AS.CHKCOM     ANOTHER COMMA
      2310        JSR DP.EVALUATE   GET EXPR
      2320        PLA               GET D
      2330        TAY
      2340        PLA               GET W
      2350        JSR FORMAT.PRINT
      2360        JMP PRINT.END
      2370 *---COMMA AFTER ITEM-------------
      2380 .2     JSR AS.CROUT      DP18'S KIND OF TABBING
      2390 *---"," OR ";" AFTER ITEM--------
      2400 .3     JSR AS.CHRGET     NEXT CHAR
      2410        BNE .1            NEXT PRINT ITEM
      2420        RTS
      2430 *--------------------------------
      2440 DP.PRINT.USING
      2450        LDA #1       PRINT,NOT INPUT
      2460 *--------------------------------
      2470 PRINT.INPUT
      2480        STA INPUT.FLAG    0=INPUT, 1=PRINT
      2490        JSR AS.CHRGET     EAT THE $
      2500        JSR AS.FRMEVL     GET PICTURE
      2510        JSR AS.FRESTR     ERR IF NOT STRING, FREE TEMP
      2520        STX P1              ADDR IN Y,X, LEN IN A
      2530        STY P1+1
      2540        STA STR.LEN
      2550        INC STR.LEN       WE'RE GOING TO ADD ONE
      2560        TAY               LENGTH TO Y
      2570        LDA #0            PUT 0 AT END OF PICTURE
      2580        STA PICTURE.BUF,Y
      2590        STA STACK.PNTR
      2600        STA FLD.FLAG
      2610 .1     DEY
      2620        LDA (P1),Y        MOVE PICTURE TO BUFFER
      2630        STA PICTURE.BUF,Y
      2640        TYA               TEST FOR END
      2650        BNE .1            ...MORE
      2660        STY REPEAT.CNT    Y IS 0
      2670        DEY               Y = $FF
      2680        JSR PRUS.CLEAR    CLEAR VARIABLES
      2690 *--------------------------------
      2700 *   PARSE THE PICTURE
      2710 *--------------------------------
      2720 PRUS.NEXT
      2730        INY               NEXT CHAR
      2740        CPY STR.LEN     DONE?
      2750        BEQ .1            ...YES
      2760        LDA PICTURE.BUF,Y GET A CHAR
      2770        STY TEMP2         SAVE PICTURE PNTR
      2780        JSR LOOKUP
      2790        LDY TEMP2         RESTORE PICTURE PNTR
      2800        JMP PRUS.NEXT
      2810 .1     LDA INPUT.FLAG
      2820        BNE .2
      2830        JMP AS.CROUT
      2840 .2     JMP PRINT.END     HANDLE ; AT END OF STATEMENT
      2850 *--------------------------------
      2860 * LOOKUP LOOKS UP THE ENTRY CORRESPONDING TO (A)
      2870 *--------------------------------
      2880 LOOKUP STA CHAR     SAVE KEY
      2890        LDY #-3
      2900 .1     INY
      2910        INY
      2920        INY          NEXT ENTRY
      2930        LDA TBL.BASE,Y
      2940        BEQ .7       END OF TABLE
      2950        CMP CHAR     ONE WE WANT?
      2960        BNE .1       NO,NEXT ENTRY
      2970 *---FOUND CHAR IN TABLE----------
      2980        CPY #L.BOTH       NEW FIELD?
      2990        BCC .2            ...MAYBE NOT
      3000        LDA #0            START A NEW FIELD
      3010        STA FLD.FLAG
      3020        BEQ .3            ...ALWAYS
      3030 .2     LDA FLD.FLAG      BEGINNING OF FIELD?
      3040        BNE .3            ...NO, NOT A NEW FIELD
      3045        JSR PRUS.CLEAR    ...YES, NEW FIELD
      3050        LDA TEMP2
      3060        STA FLD.START
      3070        INC FLD.FLAG
      3080 *---PRINT WHATEVER'S NEEDED------
      3090 .3     CPY #L.EITHER
      3100        BCC .4       ...ONLY TRY PRT.STR.IF.NEEDED
      3110        JSR PRT.NUM.IF.NEEDED
      3120        CPY #L.BOTH
      3130        BCC .5       ...ONLY TRY PRT.NUM.IF.NEEDED
      3140 .4     JSR PRT.STR.IF.NEEDED
      3150 *---GET ROUTINE ADDRESS----------
      3160 .5     LDA TBL.BASE+2,Y
      3170        PHA          PUT ADDRESS ON STACK
      3180        LDA TBL.BASE+1,Y
      3190        PHA
      3200        LDY REPEAT.CNT    GET THE COUNT
      3210        BNE .6       COUNT IS NON-0
      3220        INY          COUNT IS 0, SO MAKE IT 1
      3230 .6     LDA #0       CLEAR REPEAT.CNT
      3240        STA REPEAT.CNT
      3250        LDA CHAR     GET THE ORIGINAL CHARACTER
      3260        RTS          JUMP TO ROUTINE
      3270 *---CHAR NOT IN TABLE------------
      3280 .7     LDA CHAR     GET CHAR AGAIN
      3290        EOR #'0      CHECK FOR DIGIT 0-9
      3300        CMP #10
      3310        BCS .9       ...NOT A NUMBER
      3320        STA TEMP3
      3330        LDA REPEAT.CNT    PREVIOUS * 10
      3340        ASL               *2
      3350        ASL               *4
      3360        ADC REPEAT.CNT    *5
      3370        ASL               *10
      3380        ADC TEMP3         + DIGIT
      3390        STA REPEAT.CNT
      3400        LDA FLD.FLAG      BEGINNING OF FIELD?
      3410        BNE .8            ...NO
      3420        LDA TEMP2         YES, SAVE STARTING POSN
      3430        STA FLD.START
      3440        INC FLD.FLAG
      3450 .8     RTS
      3460 *---NOT IN TABLE, NOT A DIGIT----
      3470 .9     JSR PRT.STR.IF.NEEDED
      3480        JSR PRT.NUM.IF.NEEDED
      3490 *--------------------------------
      3500 PRUS.CLEAR
      3510        LDX #1
      3520        STX W        W = 1
      3530        DEX          REST = 0
      3540        STX D
      3550        STX DECFLG   NO DECIMAL
      3560        STX SIGN.CHAR1
      3570        STX FOUND.NUM    FLAG IF # HAS BEEN FOUND
      3580        STX FOUND.STR
      3590        STX FOUND.LEN
      3600        STX FOUND.CHAR
      3610        RTS
      3620 *--------------------------------
      3630 *   TABLE IS IN THREE SECTIONS:
      3640 *      1ST SECTION (BEFORE L.EITHER) ARE FOR
      3650 *      FOR DESCRIBING NUMERIC FIELDS, AND CAN
      3660 *      TERMINATE A STRING FIELD.
      3670 *
      3680 *      2ND SECTION (BTWN L.EITHER & L.BOTH) IS
      3690 *      FOR DESCRIBING STRING FIELDS, AND CAN
      3700 *      TERMINATE A NUMERIC FIELD
      3710 *
      3720 *      3RD SECTION (AFTER L.BOTH) CAN TERMINATE
      3730 *       BOTH KINDS OF FIELDS.
      3740 *
      3750 *      TABLE FORMAT = #CHAR,ADDRESS-1
      3760 *      END OF TABLE MARKED WITH $00
      3770 *--------------------------------
      3780        .MA TBL
      3790        .DA #']1',]2-1
      3800        .EM
      3810 *--------------------------------
      3820 TBL.BASE
      3830        >TBL "+",IP.PLUS.MINUS   -#-
      3840        >TBL "-",IP.PLUS.MINUS   -#-
      3850        >TBL "#",IP.NUMBER       -#-
      3860        >TBL "*",IP.ASTERISK     -#-
      3870        >TBL "Z",IP.ZERO         -#-
      3880        >TBL ".",IP.POINT        -#-
      3890        >TBL ",",IP.COMMA        -#-
      3900 L.EITHER .EQ *-TBL.BASE
      3910        >TBL "A",IP.ACR          -$-
      3920        >TBL "C",IP.ACR          -$-
      3930        >TBL "R",IP.ACR          -$-
      3940 L.BOTH   .EQ *-TBL.BASE
      3950        >TBL "'",IP.QT           -#$-
      3960        >TBL "/",IP.SLASH        -#$-
      3970        >TBL "X",IP.X            -#$-
      3980        >TBL "H",IP.HTAB         -#$-
      3990        >TBL "V",IP.VTAB         -#$-
      4000        >TBL ">",IP.GREATER      -#$-
      4010        .HS 00       END OF TABLE
      4020 *--------------------------------
      4030 *   Z -- Digit position marker, zero fill
      4040 *   # -- Digit position marker, blank fill
      4050 *   * -- Digit position marker, star fill
      4060 *--------------------------------
      4070 IP.ZERO
      4080        LDA #'0      USE 0 FOR FILL CHAR
      4090        .HS 2C
      4100 IP.NUMBER
      4110        LDA #' '     USE BLANK FOR FILL CHAR
      4120 IP.ASTERISK
      4130        STA FILL.CHAR  SAVE AS FILL CHAR
      4140 .1     JSR STA.WBUFX.INX
      4150        INC FOUND.NUM  FOUND A DIGIT
      4160        INC W        LENGTH
      4170        PHA
      4180        LDA DECFLG   HAD DECIMAL PT?
      4190        BEQ .2       NO
      4200        INC D        YES
      4210 .2     PLA
      4220        DEY
      4230        BNE .1       NEXT ONE
      4240        RTS
      4250 *--------------------------------
      4260 *   + -- Sign position marker (prints + or -)
      4270 *   - -- Sign position marker (prints space or -)
      4280 *--------------------------------
      4290 IP.PLUS.MINUS
      4300        STA SIGN.CHAR1 SAVE SIGN CHAR
      4310        JMP STA.WBUFX.INX
      4320 *--------------------------------
      4330 *   . -- Decimal position marker
      4340 *--------------------------------
      4350 IP.POINT
      4360        INC DECFLG   FOUND A DECIMAL POINT
      4370 *--------------------------------
      4380 *   , -- Puts a comma in a number
      4390 *--------------------------------
      4400 IP.COMMA
      4410 STA.WBUFX.INX
      4420        STA WBUF,X   SAVE CHAR
      4430        INX
      4440        RTS
      4450 *--------------------------------
      4460 *   A -- String field, left justified
      4470 *   C -- String field, centered
      4480 *   R -- String field, right justified
      4490 *--------------------------------
      4500 IP.ACR INC FOUND.STR     FOUND A STRING
      4510        STA FOUND.CHAR    SAVE THE CHAR
      4520        TYA
      4530        CLC
      4540        ADC FOUND.LEN  ADD LENGTH TO REPEAT COUNT
      4550        STA FOUND.LEN
      4560        RTS
      4570 *--------------------------------
      4580 *   ' -- Start of embedded string
      4590 *--------------------------------
      4600 IP.QT
      4610 .1     LDX TEMP2         X = PICTURE PNTR
      4620 .2     INX
      4630        LDA PICTURE.BUF,X GET CHAR
      4640        CMP #''           APOSTROPHE?
      4650        BNE .3            ...NO, PRINT IT
      4660        LDA PICTURE.BUF+1,X
      4670        CMP #''           TWO APOSTROPHE'S IN A ROW?
      4680        BNE .4            ...NO, MEANS END OF LITERAL
      4690        INX               ...YES, PRINT APOSTROPHE
      4700 .3     JSR AS.COUT
      4710        JMP .2
      4720 .4     DEY          REPEAT COUNT
      4730        BNE .1       ...REPEAT THE STRING
      4740        STX TEMP2    NEW PICTURE PNTR
      4750        RTS
      4760 .5     JMP AS.SYNERR
      4770 *--------------------------------
      4780 *   / -- Print n carriage returns
      4790 *   X -- print n spaces
      4800 *--------------------------------
      4810 IP.SLASH
      4820        LDA #$0D     CR'S
      4830        .HS 2C       (SKIP NEXT 2 BYTES)
      4840 IP.X   LDA #$20     BLANKS'
      4850 .1     JSR AS.COUT  PRINT THE CHAR
      4860        DEY
      4870        BNE .1
      4880        RTS
      4890 *--------------------------------
      4900 *   H -- HTAB to column n
      4910 *   V -- VTAB to line n
      4920 *--------------------------------
      4930 IP.HTAB
      4940        DEY
      4950        STY MON.CH   HTAB
      4960        RTS
      4970 *--------------------------------
      4980 IP.VTAB
      4990        DEY
      5000        CPY #24
      5010        BCS .1       OUT OF RANGE
      5020        TYA
      5030        JMP DP.VTAB
      5040 .1     JMP AS.ILLERR  ILLEGAL QUANTITY ERROR
      5050 *--------------------------------
      5060 *   > -- CLEAR TO END OF LINE
      5070 *  >> -- CLEAR TO END OF SCREEN
      5080 *--------------------------------
      5090 IP.GREATER
      5100        LDY TEMP2
      5110        LDA PICTURE.BUF+1,Y
      5120        CMP #'>'
      5130        BEQ .1       ...CLEAR TO END OF SCREEN
      5140 *---CLEAR TO END OF LINE---------
      5150        JMP MON.CLREOL
      5160 *---CLEAR TO END OF SCREEN-------
      5170 .1     INC TEMP2
      5180        JMP MON.CLREOS
      5190 *--------------------------------
      5200 PRT.NUM.IF.NEEDED
      5210        LDA FOUND.NUM  HAS # BEEN FOUND?
      5220        BEQ .1       NO
      5230        TYA
      5240        PHA          SAVE Y
      5250        LDA INPUT.FLAG
      5260        BEQ .2       INPUT
      5270        JSR PRINT.NUM     PRINT
      5280        JMP .3
      5290 .2     JSR INPUT.NUM
      5300 .3     PLA          RESTORE Y
      5310        TAY
      5320        JSR PRUS.CLEAR
      5330 .1     RTS
      5340 *--------------------------------
      5350 PRINT.NUM
      5360        LDA #0       PUT $00
      5370        STA WBUF,X   AT END OF STRING
      5380        JSR AS.CHKCOM  MUST HAVE COMMA
      5390        JSR DP.EVALUATE   GET EXPRESSION
      5400        LDA #'0
      5410        STA ZERO.CHAR
      5420 *
      5430 *--------------------------------
      5440 PRT.NUM.1
      5450        LDA DAC.SIGN
      5460        BPL .1
      5470        LDA SIGN.CHAR1  SIGN IS -
      5480        BEQ .1       NO SIGN CHAR
      5490        INC W        RESERVE PLACE FOR SIGN
      5500 *---CONVERT VALUE INTO FOUT.BUF--
      5510 .1     LDA W
      5520        LDY D
      5530        JSR FOUT
      5540 *---FILL IN THE PICTURE----------
      5550        LDX #0       INDEX INTO WBUF
      5560        LDY #0       INDEX INTO FBUF
      5570        STY DECFLG   USE FOR DIGITS FLAG
      5580 .2     LDA WBUF,X   GET CHAR FROM PICTURE
      5590        BEQ .10      END OF PICTURE
      5600        CMP #',      COMMA?
      5610        BNE .3
      5620        INX
      5630        LDA DECFLG   ANY DIGITS BEFORE THIS?
      5640        BNE .2            ...YES, LEAVE COMMA
      5650        LDA FILL.CHAR     ...NO, BUT LEAVE IF FILL
      5660        CMP #' '                 IS NON-BLANK.
      5670        BNE .2       ...NOT BLANK, SO LEAVE IN THE COMMA
      5680        STA WBUF-1,X ...COVER COMMA WITH BLANK
      5690        BNE .2       ...ALWAYS
      5700 *---CHECK FOR PICTURE SIGN-------
      5710 .3     JSR PRUS.SGN      IF + OR -, PROCESS
      5720        BCC .2            ...WAS + OR -
      5730 *---PICTURE IS DIGIT OR DECPT----
      5740        LDA FOUT.BUF,Y    GET CHAR FROM VALUE STRING
      5750        CMP #$20          SPACE?
      5760        BNE .5            ...NO
      5770        LDA FILL.CHAR     ...YES, USE FILL CHAR
      5780 .5     PHA               SAVE FOUT OR FILL CHAR
      5790        CMP #'-           IS IT A SIGN CHAR?
      5800        BNE .7            ...NO
      5810        LDA SIGN.CHAR1    IS THERE A SIGN IN FORMAT?
      5820        BNE .8            ...YES, SKIP THE SIGN
      5830        LDA WBUF+1,X      ...NO, INSTALL SIGN HERE
      5840        CMP #',           (UNLESS NEXT PIC.CHAR IS COMMA)
      5850        BNE .6            ...NOT COMMA
      5860        LDA FILL.CHAR     ...COMMA, SO COVER WITH FILLER
      5870        JSR STA.WBUFX.INX
      5880 .6     LDA FOUT.BUF,Y    GET SIGN CHAR AGAIN
      5890 .7     JSR STA.WBUFX.INX
      5900 .8     PLA               GET FOUT OR FILL CHAR BACK
      5910        INY               ADVANCE FOUT PNTR
      5920        CPY INDEX         END OF FOUTBUF?
      5930        BCS .9            ...YES
      5940        CMP FILL.CHAR     IF WE INSTALLED A DIGIT
      5950        BEQ .2            WE MUST SET THE DIGITS FLAG
      5960        CMP #'-           SIGN CHAR?
      5970        BEQ .2            ...YES
      5980        INC DECFLG        FOUND A DIGIT
      5990        BNE .2            ...ALWAYS
      6000 *---END OF FOUT.BUF--------------
      6010 .9     LDA WBUF,X
      6020        JSR PRUS.SGN
      6030 *---END OF FOUT OR PICTURE-------
      6040 .10    LDY #0
      6050 .11    LDA WBUF,Y
      6060        BEQ .12
      6070        JSR AS.COUT  PRINT IT
      6080        INY
      6090        BNE .11      ALWAYS
      6100 .12    RTS
      6110 *--------------------------------
      6120 PRUS.SGN
      6130        CMP #'+      SIGN?
      6140        BNE .1       NO
      6150        INX
      6160        LDA DAC.SIGN
      6170        BPL .2      SIGN ALREADY +
      6180        LDA #'-
      6190        STA WBUF-1,X
      6200        BNE .2       ALWAYS
      6210 .1     CMP #'-      -?
      6220        BNE .3       NO
      6230        INX
      6240        LDA DAC.SIGN
      6250        BMI .2      SIGN ALREADY -
      6260        LDA FILL.CHAR
      6270        STA WBUF-1,X   BLANK OUT SIGN
      6280 .2     CLC
      6290        RTS
      6300 .3     SEC
      6310        RTS
      6320 *--------------------------------
      6330 PRT.STR.IF.NEEDED
      6340        LDA FOUND.STR HAS STRING BEEN FOUND?
      6350        BEQ .3       NO
      6360        TYA
      6370        PHA          SAVE Y
      6380        LDA INPUT.FLAG
      6390        BEQ .1
      6400        JSR PRINT.STR
      6410        JMP .2
      6420 .1     JSR INPUT.STR
      6430 .2     PLA
      6440        TAY          RESTORE Y
      6450        JSR PRUS.CLEAR
      6460 .3     RTS
      6470 *--------------------------------
      6480 PRINT.STR
      6490        LDA #$20
      6500        STA FILL.CHAR
      6510        JSR AS.CHKCOM  MUST HAVE COMMA
      6520        JSR AS.FRMEVL     GET EXPRESSION
      6530        JSR AS.FRESTR     GET ADR AND LEN
      6540        STX P2
      6550        STY P2+1
      6560 *--------------------------------
      6570 PRINT.STR.1
      6580        PHA          SAVE LENGTH
      6590        SEC               LENGTH IS IN A
      6600        SBC FOUND.LEN     SUBTRACT FIELD LENGTH
      6610        BEQ .2            ...SAME, SO OKAY
      6620        BCC .2            ...EXP IS SHORTER THAN FIELD
      6630 *---FIELD OVERFLOW---------------
      6640        PLA               DISCARD LENGTH
      6650        LDY FOUND.LEN     GET FIELD LEN
      6660        LDA #'*           OVERFLOW CHAR
      6670 .1     JSR AS.COUT
      6680        DEY
      6690        BNE .1
      6700        RTS
      6710 *---JUSTIFY IN FIELD-------------
      6720 .2     EOR #$FF     GET POSITIVE #
      6730        TAY
      6740        INY
      6750        STY FOUND.LEN
      6760        LDA FOUND.CHAR
      6770        CMP #'A      LJ FIELD
      6780        BEQ .5
      6790        CMP #'C      CJ FIELD
      6800        BEQ .4
      6810 *---RIGHT JUSTIFY----------------
      6820        JSR PRINT.Y.SPACES
      6830        PLA          RESTORE STRING LEN
      6840        JMP PRT.STR  PRINT STRING
      6850 *---CENTER JUSTIFY---------------
      6860 .4     TYA          # OF SPACES
      6870        LSR          DIVIDE BY 2
      6880        TAY          # LEADING BLANKS
      6890        ADC #0       +1 IF IT WAS ODD
      6900        STA FOUND.LEN   # TRAILING BLANKS
      6910        JSR PRINT.Y.SPACES
      6920 *---LEFT JUSTIFY-----------------
      6930 .5     PLA          GET STRING LEN
      6940        JSR PRT.STR  PRINT IT
      6950        LDY FOUND.LEN  TRAILING SPACES
      6960        JMP PRINT.Y.SPACES
      6970 *--------------------------------
      6980 PRT.STR
      6990        STA FOUND.CHAR    LEN OF STRING
      7000        LDY #$FF
      7010 .1     INY
      7020        CPY FOUND.CHAR
      7030        BCS .2       DONE
      7040        LDA (P2),Y   GET CHAR
      7050        JSR AS.COUT  PRINT IT
      7060        JMP .1
      7070 .2     RTS
      7080 *--------------------------------
      7090 PRINT.Y.SPACES
      7100        TYA          TEST COUNT
      7110        BEQ .2       ...ZERO, EXIT NOW
      7120        LDA FILL.CHAR
      7130 .1     JSR AS.COUT
      7140        DEY
      7150        BNE .1
      7160 .2     RTS
      7170 *--------------------------------
      7180 DP.VTAB
      7190        STA MON.CV
      7200        JMP MON.VTABZ
      7210 *--------------------------------

Symbol Table Source Maker | Peter McInerney and Bruce Love

When developing a very large program in separately assembled stages, it is nice to be able to carry forward the information in the symbol table of one section into the equates section to later section. You might do this as a normal part of development or as response to a bug detected in an earlier stage which forces some re-assembly. We designed this utility program to take all the hard work out of the process of building an equate file from a symbol table.

After an assembly, BRUNning the following utility will cause whatever source is in memory to be replaced by a series of .EQ lines constructed from the current symbol table. All global labels are included, in numerical order. The generated source lines can be saved or merged in the usual fashion.

The plan of the program falls into three steps. First the existing symbol table is sorted into numeric order by the value of each symbol. Next a line corresponding to each symbol is constructed and merged into the source code. Finally the source lines are renumbered starting with 1000 using an increment of 10, and control is passed back to the S-C Macro Assembler.

We originally wrote our program based on Version 1.1 of the S-C Macro Assembler. Version 2.0 differs in that each symbol value uses four bytes rather than two, and the RENUMBER routine is in a different location. Bob Sander-Cederlof added some code to handle Version 2.0, and that version is listed here. All the changes that need to be made to use our utility with Version 1.1 are controlled by .DO-.ELSE-.FIN sets, so that you only have to change line 1030 to assemble the other version. Since the following listing was made with the CON listing option, the code between .ELSE and .FIN is shown as non-assembled lines; this allows you to type in both versions of the program.

After an assembly, the symbol table consists of 26 chains of symbols. A hash table of 26 pointers contains the beginning of each of the 26 chains. There is one chain for each letter of the alphabet, and symbols are assigned to a chain based on the first letter of the symbol name. Within each chain, the symbols are linked together in alphabetical order. The first two bytes of each symbol entry are a forward pointer to the next symbol in the chain, or $0000 if it is the end of the chain. If there is no chain for a particular letter, that pointer in the hash table will be $0000.

The value of the symbol is in the next two or four bytes (Version 1.1 or 2.0, respectively). The high byte of the value is first, the low byte last. The byte following the value contains the length of the symbol name in the lower six bits. The length will be a number between 1 and 32, or $01 and $20. Following the length byte are the characters of the name itself. Some other information is stored in the table, including various flags, local labels, and any macro definitions which were in your program; however, we are not concerned with these in our program.

The program begins by setting the output hook to point to our routine named MYCOUT. Any characters that are "printed" through the monitor's COUT routine will be routed to MYCOUT, at lines 2980-3070. MYCOUT merely stores the characters in successive positions of a buffer we put at $280. Lines 1350-1380 zap any source program still in memory, in preparation for adding the new .EQ lines.

Since every symbol carries a pointer, we decided to simply re-string them on a new chain in numeric order by value. Lines 1390-2040 build this new chain. Lines 1390-1490 and 1990-2040 step through each of the 26 alphabetical-order (A-O) chains. The numerical-order (N-O) chain is built with the pointer in ROOT pointing at the largest value, each symbol's pointer pointing at the next smallest value. When we find an A-O chain which is not empty, lines 1500-1980 chomp through the chain finding the right place in the N-O chain for each symbol.

Once the symbols are all strung on the N-O chain, lines 2050-2940 use the N-O chain to generate source lines for each symbol. Lines 2090-2100 check for the possibility of no symbols, just in case you are testing us.

Lines 2110-2210 pick up the value of the symbol (two or four bytes worth) and push it on the stack, low byte first. The loop actually pushes the byte following the value as well, because it saved a few program bytes to include it in the loop. Line 2220 pulls that byte back off.

Lines 2220-2280 pick up the characters of the symbol name and "print" them. Remember that the print hook points to MYCOUT, so that the characters are really placed in WBUF starting at WBUF+3. (The locations WBUF through WBUF+2 are reserved for the line length and line number.)

Lines 2290-2360 generate enough blanks to tab over to column 25. If the symbol is longer than 25 characters, only one blank is generated. All of the blanks are squeezed into a single compressed blank token ($80 + # of blanks). We put this into WBUF by calling MYCOUT1 to avoid the AND #$7F at the beginning of MYCOUT.

Lines 2370-2420 "print" the string of characters " .EQ $", which are stored in backwards order in line 3090.

Lines 2430-2610 "print" the value of the symbol in hexadecimal. Since the value may have up to three bytes of leading zeros, there is code here to suppress those bytes.

Lines 2620-2720 terminate the source line in WBUF with a $00 code, and store the line length in the first byte position. Now the line is ready to be added to the source code being built up.

Lines 2730-2790 make room for the new source line by lowering the pointer PRG.BEG, which points at the start of the source code. We are adding the source lines starting with the highest value, which will be at the end of the source program, and working down to the lowest value at the beginning of the source program.

Lines 2800-2850 copy the line into the hole we just made. Note that we have not filled in a valid line number yet.

Lines 2860-2940 promote the ROOT pointer to the next symbol in the N-O chain. If there are no more symbols, line 2950 calls on the RENUMBER subroutine inside the S-C Macro Assembler to put real line numbers in each line. The point at which RENUMBER is entered is just after a series of three JSR's, all to the same address. The instruction we branch to is a "CPX #$06". We are pointing this out here just in case you have a version of the S-C Macro Assembler with a slightly different position for the RENUMBER subroutine. Of course, you could omit line 2950 and just remember to type "REN" after running our program.

Finally, line 2960 restores the output hook to the 40-column screen output. This will not be what you want if you are using an 80-column card. If you are doing that, we suggest saving the output hook way back at the beginning before stuffing MYCOUT into it, and then restoring the original value here. We didn't do it that way because we were trying every possible way to make this whole program fit in only one page.

One caveat remains. We did not include any test to see whether the source code being generated starts to overlap the end of the symbol table. If you have a gigantic symbol table, say over half of the available memory for source+symbols, you may run into this problem.

When you are using this program, be sure you save the source of whatever you assembled first. Our program replaces the source in memory with the .EQ source lines. Also, realize that the symbol table is essentially wiped out by running our program, because all the chain links are restructured for numerical order. You will have to re-assemble the original program to re-create the original symbol table. Of course, if you assemble the source lines we generate, you will re-create all the global labels of the original program.

We think you will find many uses for our program, beyond the ones which prompted us to write it. We are very proud that we managed to fit everything into a single page, but don't let that stop you from adding features to fit your own needs.

      1000        .LIST CON
      1010 *SAVE S.SYMBOL SOURCEROR
      1020 *--------------------------------
      1030 VERSION    .EQ 1    0=1.1, 1=2.0
      1040 *--------------------------------
      1050 *   THE FOLLOWING ADDRESS SHOULD POINT
      1060 *   TO A "CPX #$06" INSTRUCTION.  IF IT
      1070 *   DOESN'T IN YOUR PARTICULAR COPY, FIND
      1080 *   THAT INSTRUCTION AND PLACE THE CORRECT
      1090 *   ADDRESS HERE.
      1100 *--------------------------------
      1110     .DO VERSION     ...V 2.0
      1120 RENUMBER .EQ $D65B       V 2.0
      1130     .ELSE           ...V 1.1
      1140 RENUMBER .EQ $D7DA       V 1.1
      1150     .FIN
      1160 *--------------------------------
      1170 PTR        .EQ $00,01
      1180 A1         .EQ $02,03
      1190 A2         .EQ $04,05
      1200 ROOT       .EQ $06,07
      1210 XSAVE      .EQ $8
      1220 CSW        .EQ $36,37
      1230 *--------------------------------
      1240 HASH.TAB   .EQ $132
      1250 WBUF       .EQ $280
      1260 *--------------------------------
      1270 PRBYTE     .EQ $FDDA
      1280 COUT       .EQ $FDED
      1290 SETVID     .EQ $FE93
      1300 *--------------------------------
      1310 *      PROGRAM POINTERS
      1320 *--------------------------------
      1330 PRG.BEG    .EQ $CA,CB
      1340 PRG.END    .EQ $4C,4D
      1350 *--------------------------------
      1360 MAKE.SOURCE.FROM.SYMBOL.TABLE
      1370        LDA #MYCOUT       GRAB THE OUTPUT HOOK
      1380        STA CSW
      1390        LDA /MYCOUT
      1400        STA CSW+1
      1410        LDA PRG.END       EMPTY THE PROGRAM AREA
      1420        STA PRG.BEG
      1430        LDA PRG.END+1
      1440        STA PRG.BEG+1
      1450 *---SCAN THROUGH HASH TABLE------
      1460        LDX #0
      1470        STX ROOT          EMPTY NUMERIC-ORDER CHAIN
      1480        STX ROOT+1
      1490 *---GET START OF NEXT CHAIN------
      1500 .1     LDA HASH.TAB+1,X
      1510        BEQ .6            ...THIS CHAIN IS EMPTY
      1520        STA PTR+1
      1530        LDA HASH.TAB,X
      1540        STA PTR
      1550        STX XSAVE
      1560 *---SEARCH FOR POSITION IN N-O CHAIN---
      1570 .2     LDA #ROOT    START SEARCH FROM BEGINNING
      1580        STA A1            OF NUMERIC-ORDER CHAIN
      1590        LDA /ROOT
      1600        STA A1+1
      1610 .3     LDA A1       PROMOTE BOTH POINTERS
      1620        STA A2            TO THE NUMERIC-ORDER CHAIN
      1630        LDA A1+1
      1640        STA A2+1
      1650        LDY #0
      1660        LDA (A1),Y
      1670        TAX
      1680        INY
      1690        LDA (A1),Y
      1700        STA A1+1
      1710        STX A1
      1720        BEQ .5
      1730 *---COMPARE A-O WITH N-O VALUE---
      1740     .DO VERSION     ...V 2.0
      1750        LDX #3       4-BYTE VALUES
      1760     .ELSE           ...V 1.1
      1770        LDX #1       2-BYTE VALUES
      1780     .FIN
      1790        SEC
      1800 .4     INY
      1810        LDA (A1),Y
      1820        SBC (PTR),Y
      1830        DEX
      1840        BPL .4
      1850        BCS .3       ...A-O VALUE < N-O VALUE
      1860 *---INSERT A-O VALUE INTO N-O CHAIN---
      1870 .5     LDY #0
      1880        LDA (PTR),Y
      1890        TAX
      1900        LDA A1
      1910        STA (PTR),Y
      1920        LDA PTR
      1930        STA (A2),Y
      1940        INY
      1950        LDA (PTR),Y
      1960        PHA
      1970        LDA A1+1
      1980        STA (PTR),Y
      1990        LDA PTR+1
      2000        STA (A2),Y
      2010        STX PTR
      2020        PLA
      2030        STA PTR+1
      2040        BNE .2       ...NOT END OF CHAIN YET
      2050 *---NEXT HASH CHAIN--------------
      2060        LDX XSAVE
      2070 .6     INX
      2080        INX
      2090        CPX #2*26    26 HASH CHAINS
      2100        BCC .1       ...STILL ANOTHER CHAIN
      2110 *--------------------------------
      2120 *   RUN THROUGH NUMERIC-ORDER CHAIN
      2130 *   AND CREATE A SOURCE LINE FOR EACH SYMBOL.
      2140 *--------------------------------
      2150        LDA ROOT+1   CHECK FOR NO CHAIN AT ALL
      2160        BEQ .17
      2170     .DO VERSION     ...V 2.0
      2180 .8     LDX #4
      2190     .ELSE           ...V 1.1
      2200 .8     LDX #2
      2210     .FIN
      2220        LDY #2
      2230 .9     LDA (ROOT),Y
      2240        PHA
      2250        INY
      2260        DEX
      2270        BPL .9
      2280        PLA
      2290        AND #$3F
      2300        TAX
      2310 .10    LDA (ROOT),Y
      2320        JSR COUT
      2330        DEX
      2340        BNE .10
      2350 *---TAB TO .EQ COLUMN------------
      2360        LDA #$81
      2370        CPY #25
      2380        BCS .11
      2390        TYA
      2400        EOR #$FF
      2410        ADC #$9A
      2420 .11    JSR MYCOUT1
      2430 *---OUTPUT ".EQ $"---------------
      2440        LDX #4
      2450 .12    LDA STRING,X
      2460        JSR COUT
      2470        DEX
      2480        BPL .12
      2490 *---OUTPUT VALUE OF SYMBOL-------
      2500     .DO VERSION     ...V 2.0
      2510        LDX #4
      2520        PLA
      2530        BNE .16      ...PRINT 32-BITS
      2540        DEX
      2550        PLA
      2560        BNE .16      ...PRINT 24-BITS
      2570     .ELSE           ...V 1.1
      2580        LDX #2
      2590     .FIN
      2600        DEX
      2610        PLA
      2620        BNE .16      ...PRINT 24-BITS
      2630        DEX
      2640 .13    PLA
      2650 .16    JSR PRBYTE
      2660        DEX
      2670        BNE .13
      2680 *---APPEND $00 BYTE--------------
      2690        TXA          APPEND $00 BYTE
      2700     .DO VERSION     ...V 2.0
      2710        STA WBUF-4,Y
      2720        DEY
      2730        DEY
      2740     .ELSE           ...V 1.1
      2750        STA WBUF-2,Y
      2760     .FIN
      2770        DEY
      2780        STY WBUF     # BYTES IN LINE
      2790 *---MAKE ROOM IN SOURCE AREA-----
      2800        LDA PRG.BEG
      2810        SEC
      2820        SBC WBUF
      2830        STA PRG.BEG
      2840        BCS .14
      2850        DEC PRG.BEG+1
      2860 *---COPY LINE INTO SOURCE AREA---
      2870 .14    DEY
      2880 .15    LDA WBUF,Y
      2890        STA (PRG.BEG),Y
      2900        DEY
      2910        BPL .15
      2920 *---NEXT SYMBOL FROM CHAIN-------
      2930        INY          Y=0
      2940        LDA (ROOT),Y      FROM THE NUMERIC-ORDER CHAIN
      2950        TAX
      2960        INY
      2970        LDA (ROOT),Y
      2980        STA ROOT+1
      2990        STX ROOT
      3000        BNE .8       ...NOT END OF CHAIN YET
      3010        JSR RENUMBER ...END, SO RENUMBER THE LINES
      3020 .17    JMP SETVID   RESTORE HOOK AND RETURN
      3030 *--------------------------------
      3040 MYCOUT
      3050        AND #$7F
      3060 MYCOUT1
      3070        INY
      3080     .DO VERSION     ...V 2.0
      3090        STA WBUF-5,Y
      3100     .ELSE           ...V 1.1
      3110        STA WBUF-3,Y
      3120     .FIN
      3130        RTS
      3140 *--------------------------------
      3150 STRING .AS "$ QE."
      3160 *--------------------------------
      3170 END

Short Single-Byte Hex-to-decimal Printer | Bob Sander-Cederlof

Inside DOS there exists a subroutine whose purpose is to convert a single byte into a three digit decimal number, and print it out. It is called twice from within the CATALOG processor: to print the volume number, and to print the number of sectors in a file. It isn't very space or speed efficient, and has been picked apart in various articles in Nibble and elsewhere. The DOS routine is located at $AE42.

In any case, here is a shorter routine that does the same job. I also added a little test routine which exercises the subroutine by calling it for every possible value of a byte.

Lines 1200-1290 are the test routine. It is essentially equivalent to: FOR A = 0 TO 255 : PRINT X" "; : NEXT X.

Lines 1020-1160 are the conversion and print subroutine. It is written as a loop that runs the Y-register from 2 down to 0. Line 1030 starts Y=2, and lines 1140-1150 decrement and test Y, like BASIC's NEXT Y.

Another loop keeps subtracting a table entry from the value being converted until the remainder is smaller than the table entry. The table contains powers of ten. The first time through, 100 is subtracted as many times as possible. Each time, the X-register is incremented. Since line 1040 started X out as the ASCII code for zero, when the inner loop finishes X will have the ASCII code for the next decimal digit of the original value. Line 1120 calls the monitor COUT routine to print the digit.

The next time through the table value that gets subtracted is 10, and the third and last time through 1 gets subtracted. So you see that we first print the hundreds digit, then the tens digit, and finally the units digit.

The DOS version takes 40 bytes plus a three byte table, and mine takes 25 bytes plus a three byte table. It's probably not fair to compare 40 to 25 too unfavorably, because mine does use the X-register while the DOS version does not. The part of the CATALOG code that prints the number of sectors in a file requires that the X-register not be changed, so mine is not quite compatible as is. On the other hand, DOS goes to the trouble of saving the value to be printed in location $44, which is unnecessary, and also saves a value in $45 which is otherwise totally ignored. This foolishness takes place at $ADB9-$ADBF and $AE04-$AE0A.

Anyway, here is my code:

      1000 *SAVE S.PRINT 000-255
      1010 *--------------------------------
      1020 PRINT.000.255
      1030        LDY #2
      1040 .1     LDX #"0"
      1050 .2     CMP DECTBL,Y
      1060        BCC .3       DIGIT FINISHED
      1070        SBC DECTBL,Y
      1080        INX
      1090        BNE .2       ...ALWAYS
      1100 .3     PHA          SAVE REMAINDER
      1110        TXA
      1120        JSR $FDED
      1130        PLA          GET REMAINDER
      1140        DEY
      1150        BPL .1
      1160        RTS
      1170 *--------------------------------
      1180 DECTBL .DA #1,#10,#100
      1190 *--------------------------------
      1200 T      LDA #0
      1210 .1     PHA          SAVE VALUE
      1220        JSR PRINT.000.255
      1230        LDA #" "
      1240        JSR $FDED
      1250        PLA          GET PREVIOUS VALUE
      1260        CLC
      1270        ADC #1       INCREMENT
      1280        BNE .1
      1290        RTS

Apple Assembly Line is published monthly by S-C SOFTWARE CORPORATION, P.O. Box 280300, Dallas, Texas 75228. Phone (214) 324-2050. Subscription rate is $18 per year in the USA, sent Bulk Mail; add $3 for First Class postage in USA, Canada, and Mexico; add $12 postage for other countries. Back issues are available for $1.80 each (other countries add $1 per back issue for postage).

All material herein is copyrighted by S-C SOFTWARE CORPORATION, all rights reserved. (Apple is a registered trademark of Apple Computer, Inc.)