Apple Assembly Line
Volume 5 -- Issue 4January 1985

In This Issue...

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 9Bob 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 MakerPeter 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 PrinterBob 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.)