Volume 8 -- Issue 2 | November 1987

In This Issue...

- (Pretty) Fast DOS Text Writer
- Strange Decimal-to-Binary Conversion
- Getting a Pointer from a Handle
- Converting BCD to Binary, Packing Fields
- Key Edit Program

Update on Drawing Circles

In case you missed it, Richard Miner presented a nice refinement to Dick Pountain's Circle Drawing Algorithm a in letter to the editor of Byte Magazine, December, 1987, pages 26-30. Miner's method allows you to use X- and Y-scale factors, so that you can cope with non-square aspect ratios on video screens and printers.

Furthermore, Brent Iverson has published an article on Hi-Res circle drawing in Nibble Magazine, January 1988, pages 68-71. He uses the same algorithm I did in my September article, and converts it to assembly language using MicroSparc's MacroSoft macros. The resulting code ($35A bytes) takes over three times as much memory the program I published in the September AAL, but it was probably easier to write.

Webster Said It

Do you know who Noah Webster was? His name is on practically every American dictionary, because he wrote the first one. (I have a copy of his small 1806 edition and another of his very large one from 1828.) Called America's foremost pioneer lexicographer, he mastered 20 languages including Hebrew and Greek. In 1833 he published his own revision of the King James Version of the Bible. I bought a reprint of it this week (Baker Book House, 1987), and intend to read it through in the coming year. Webster said, "The Bible is the chief moral cause of all that is good, and the best corrector of all that is evil, in human society; the best book for regulating the temporal concerns of men, and the only book that can serve as an infallible guide to future felicity."

Still a Bug in IIgs Smartport

Alan J. Silver reports in the Jan 88 issue of Open Apple that the new version 01 IIgs ROMs clobber locations $57 thru $5A on the caller's Direct Page when you make a Smartport call to the firmware in slot 5. The older ROMs clobbered the same locations in "true" page zero, as reported in AAL, May, 1987, page 26.

(Pretty) Fast DOS Textwriter | R.R. Bukrey

Bill Morgan's article (Feb 87) on writing very large DOS text files very fast was interesting to me. Not too long ago, I had tackled a similar problem. I had modified Cornelis Bongers' Cross Assembler (Micro on the Apple, Vol. 3) to produce output compatible with the DOS Toolkit Assembler, and I needed a way to get the output to disk. On discovering DOS's aversion to handling text files from machine language, I realized I had to write something from scratch. The result was TEXTFILE.

TEXTFILE is fast (5.5 sectors per second), although presumably not as fast as Bill's program. As noted in Bill's article, the speed advantage comes mainly from keeping the VTOC, T/S list and catalog sectors all in memory, rather than reading and writing them repeatedly to and from disk.

Thus, while TEXTFILE is not super-fast, I think it does offer some advantages: it doesn't require the file space to be previously allocated. It reads the disk directory and either locates the desired file or creates it. The file size produced by TEXTFILE is limited only by available disk space.

Finally, TEXTFILE requires no patches to DOS, and since it was written with no space restrictions, it is self-contained, needing no BASIC caller to help it along. Probably the main advantage of the program, in retrospect, is that it offers a pretty straightforward tutorial on DOS file management. We can outline the workings of TEXTFILE by taking a quick tour through the listing. To make the listing a little shorter, I have turned off the listing of the macro expansion. The >SET macro, defined in lines 1510-1560, is used to store an buffer address into a pointer.

Right off, we note that we haven't been careful to avoid Applesoft's turf. Lines 1050-1210 use HIMEM and other important BASIC pointers. These would probably have to be relocated if we were intending to link with a running BASIC program.

Lines 1620-1850 input the file name and check its syntax.

The SCAN routine (line 1890) looks thru the directory for the specified name. A matchup skips ahead to FOUND (line 2940). While scanning, it saves the sector number of the first deleted file that happens by. On no matchup, this entry will be used for creating the new file. If no deleted entries are handy, the first blank one is used. Lacking even that, it quits via 'disk full error.'

If a new file entry is to be created, this is done in lines 2690-2930.

With the directory set up, we can move on to the VTOC. Lines 3040-3160 read it into its buffer and initialize counters and pointers. One important point: the first byte of the VTOC is used as a change flag: if the VTOC never changes, we can skip writing it back to the disk when we are done.

Next, the track/sector list is either read (old file) or created (new file). In the latter case, the subroutine GETFREE (lines 4610-5060) scans the VTOC for the next free sector, starting in track $22 and working down through track $03. Only one pass through the VTOC is made, and no attempt is made to mimic DOS's 'optimization,' i.e., starting near the catalog track and looking in both directions for empty space.

Once the T/S list is in place, we can start dumping data to the disk (lines 3540-4100). The loop at line 3590 fills the data buffer with 16 copies of a 16-character string. This is where the user would insert his/her own data-generating routine. As might be expected, any existing T/S list is used until exhausted, then extended by GETFREEing as needed.

This demo version of TEXTFILE is set up to quit when the sector counter reaches zero (having been initialized to 50). Any real application would similarly have to indicate end of data.

With the data safely sequestered on disk, we can restore the directory, T/S list and VTOC to disk (lines 4270-4570), and call it a day.

A parting thought: the following Applesoft program demonstrates the speed advantage of TEXTFILE over BASIC: a factor of five. Enjoy.

           100 D$=CHR$(4)
           110 PRINT D$"OPEN TTT" : PRINT D$"WRITE TTT"
           120 FOR I = 1 TO 50
           130   FOR J = 1 TO 16
                 : PRINT "THIS IS A TEST."
                 : NEXT
           140 NEXT I
           150 PRINT D$"CLOSE"

      1000 *SAVE FAST.TEXT.SAVE
      1010 *--------------------------------
      1020 *   FAST TEXTFILE SAVE PROGRAM, BY R. R. BUKREY
      1030 *--------------------------------
      1040        .LIST MOFF        DO NOT LIST MACRO EXPANSIONS
      1050 A4L    .EQ $42
      1060 STATUS .EQ $48           P-REGISTER
      1070 NAMLEN .EQ $71           FILE NAME LENGTH
      1080 PTR    .EQ $72           BUFFER POINTER & SECTOR COUNTER
      1090 DIRSEC .EQ $74           DIRECTORY SECTOR USED
      1100 FILPTR .EQ $75           POINTER TO FILE ENTRY IN DIR BUFFR
      1110 TST    .EQ $77           TRK OF T/S LIST
      1120 TSS    .EQ $78           SECT OF T/S LIST
      1130 TYP    .EQ $79           FILE TYPE
      1140 NTSL   .EQ $7A           NO. OF T/S LISTS
      1150 VY     .EQ $7B           OFFSET INTO VTOC
      1160 VB1    .EQ $7C           2-BYTE BUFFER FOR VTOC ROL
      1170 VB2    .EQ $7D
      1180 VTTRK  .EQ $7E           LAST TRACK ALLOCATED
      1190 TSPTR  .EQ $7F           T/S POINTER
      1200 EOD    .EQ $80           END OF DATA FLAG
      1210 CTR    .EQ $81
      1220 *--------------------------------
      1230 KBUFF  .EQ $200
      1240 *--------------------------------
      1250 COLDOS .EQ $3D3
      1260 RWTS   .EQ $3D9
      1270 GETIOB .EQ $3E3
      1280 *---Data Areas inside DOS--------
      1290 BUFF   .EQ $9600         DATA BUFFER
      1300 TSB    .EQ $9700         T/S LIST BUFFER
      1310 VTOC   .EQ $B3BB         VTOC BUFFER
      1320 DBUFF  .EQ $B4BB         DIRECTORY BUFFER
      1330 *
      1340 IOB    .EQ $B7E8         I/O CONTROL BLOCK
      1350 SLOT   .EQ IOB+1
      1360 DRIVE  .EQ IOB+2
      1370 VOL    .EQ IOB+3         0=ANY
      1380 TRK    .EQ IOB+4
      1390 SECT   .EQ IOB+5
      1400 BUFFAD .EQ IOB+8
      1410 OPER   .EQ IOB+12        1=READ 2=WRITE
      1420 RETCOD .EQ IOB+13
      1430 *---Subroutines inside DOS-------
      1440 DOSERR .EQ $A702         PRINT ERROR MSG
      1450 ZBUFF  .EQ $B7D6         ZERO BUFFER POINTED TO BY A4
      1460 *---Subroutines in Monitor-------
      1470 CROUT  .EQ $FD8E
      1480 HOME   .EQ $FC58
      1490 GETLIN .EQ $FD6F
      1500 *--------------------------------
      1510        .MA SET      >SET VARIABLE,VALUE
      1520        LDA #]2
      1530        STA ]1
      1540        LDA /]2
      1550        STA ]1+1
      1560        .EM
      1570 *--------------------------------
      1580        .OR $803
      1590 *--------------------------------
      1600 *   GET FILE NAME
      1610 *--------------------------------
      1620 TEXTFILE
      1630        JSR HOME
      1640        JSR CROUT
      1650        JSR CROUT
      1660        JSR GETLIN
      1670        TXA
      1680        BEQ .2            ZERO LENGTH
      1690        CPX #$1F
      1700        BCS .2            NAME TOO LONG
      1710        STX NAMLEN        SAVE LENGTH
      1720        LDA KBUFF         1ST CHAR A LETTER?
      1730        CMP #$C1
      1740        BMI .2
      1750        CMP #$DB
      1760        BPL .2
      1770        LDY #1
      1780 .1     LDA KBUFF,Y
      1790        CMP #$8D          CR = END OF NAME
      1800        BEQ SCAN
      1810        CMP #$AC          NO COMMAS ALLOWED
      1820        BEQ .2
      1830        INY
      1840        BNE .1            ALWAYS
      1850 .2     JMP SYNERR
      1860 *--------------------------------
      1870 *   SCAN DIRECTORY FOR NAME
      1880 *--------------------------------
      1890 SCAN   LDA #$60     USE SLOT 6
      1900        STA SLOT
      1910        LDX #0
      1920        STX VOL      USE ANY VOLUME #
      1930        STX DIRSEC
      1940 *   DIRSEC IS ZERO UNTIL A DELETED ENTRY OCCURS.
      1950 *   THEN IT HOLDS THE SECTOR OF THAT ENTRY.
      1960 *   FINALLY, IT IS THE SECTOR OF THE ENTRY ACTUALLY USED.
      1970        INX
      1980        STX DRIVE
      1990        STX OPER
      2000        LDA #$0F     START WITH SECTOR $0F
      2010        STA SECT
      2020        JSR DIRIOB        SET IOB BUFF ADDR & TRK
      2030        STA PTR+1
      2040 *---Read next directory sector---
      2050 .1     JSR R.W
      2060        LDA BUFFAD
      2070        CLC
      2080        ADC #$0B
      2090 *---Point to next filename-------
      2100 .2     STA PTR
      2110        LDY #0
      2120        LDA (PTR),Y       1ST CHAR OF FILE ENTRY
      2130        BEQ BLANK         BLANK ENTRY
      2140        CMP #$FF          DELETED FILE?
      2150        BEQ .6
      2160 .3     LDA (PTR),Y
      2170        STA TST,Y         SAVE T/S & TYPE
      2180        INY
      2190        CPY #3
      2200        BNE .3
      2210        LDX #0
      2220 .4     LDA (PTR),Y       COMPARE NAME IN FILE ENTRY
      2230        CMP KBUFF,X       WITH INPUT NAME
      2240        BNE .7            QUIT IF NO MATCH
      2250        INX
      2260        INY
      2270        CPX NAMLEN        DONE WITH INPUT NAME?
      2280        BCC .4            NO, GO DO REST
      2290 .5     CPY #$21          30 CHARS MAX + 3
      2300        BEQ FOUND
      2310        LDA (PTR),Y       MAKE SURE REST OF ENTRY IS BLANK
      2320        CMP #$A0
      2330        BNE .7
      2340        INY
      2350        BNE .5            ALWAYS
      2360 .6     LDA DIRSEC
      2370        BNE .7
      2380        JSR SAVDIR        SAVE POINTERS TO 1ST DELETED ENTRY
      2390 .7     LDA PTR
      2400        CLC
      2410        ADC #$23          BUMP POINTER TO NEXT ENTRY
      2420        CMP #$0C
      2430        BNE .8
      2440        INC PTR+1         PAGE CROSSED
      2450 .8     CMP #$BB
      2460        BNE .2            GO READ NEXT ENTRY
      2470 *---Next directory sector--------
      2480        DEC SECT          NEXT SECTOR
      2490        BEQ .9
      2500        DEC PTR+1
      2510        BNE .1            ALWAYS
      2520 *   HAVE NOW READ ALL DIR SECTS W/NO MATCH, NO BLANK ENTRIES
      2530 .9     LDA DIRSEC        ANY DELETED ENTRIES?
      2540        BNE .10           YES, GO USE ONE
      2550        JMP FULL          NO, DIRECTORY FULL, SO QUIT
      2560 .10    INC SECT          RESET TO SECTOR 1
      2570        JMP FE1
      2580 *--------------------------------
      2590 SAVDIR LDA SECT          SAVE DIRECTORY POINTERS
      2600        STA DIRSEC
      2610        LDA PTR
      2620        STA FILPTR
      2630        LDA PTR+1
      2640        STA FILPTR+1
      2650        RTS
      2660 *--------------------------------
      2670 *   USE FILE ENTRY FOUND, OR BUILD NEW ONE
      2680 *--------------------------------
      2690 BLANK  LDA DIRSEC        USE DELETED ENTRY, IF ANY
      2700        BEQ FE2           NONE, GO USE BLANK ONE
      2710 FE1    CMP SECT          FIND DELETED ENTRY
      2720        BEQ FE3           IN CURRENT SECTOR, GO USE IT
      2730        STA SECT          NOT HERE. GO BACK & GET IT
      2740        JSR R.W
      2750        BCC FE3           ALWAYS
      2760 FE2    JSR SAVDIR        USE CURRENT SECT
      2770 FE3    LDY #3            MOVE NAME TO ENTRY
      2780        LDX #0
      2790 FE4    LDA KBUFF,X
      2800        STA (FILPTR),Y
      2810        INY
      2820        INX
      2830        CPX NAMLEN
      2840        BCC FE4
      2850 FE5    CPY #$21          30 CHARS MAX + 3
      2860        BEQ FE6           DONE
      2870        LDA #$A0          BLANK REST OF NAME FIELD
      2880        STA (FILPTR),Y
      2890        INY
      2900        BNE FE5           ALWAYS
      2910 FE6    LDA #$FF
      2920        STA TYP           RAISE NEW ENTRY FLAG
      2930        BMI RVT           ALWAYS
      2940 FOUND  LDA TYP           CHECK FILE TYPE
      2950        BEQ FE8           UNLOCKED TEXT FILE, USE IT
      2960        CMP #$80          LOCKED TEXT FILE?
      2970        BEQ FE7
      2980        JMP TYPERR        WRONG TYPE
      2990 FE7    JMP LOCK
      3000 FE8    JSR SAVDIR        SAVE FILE ENTRY POINTERS
      3010 *--------------------------------
      3020 *   READ VTOC AND INIT COUNTERS & POINTERS
      3030 *--------------------------------
      3040 RVT    JSR VTIOB         SET IOB BUFF ADDR & SECT
      3050        JSR R.W
      3060        LDX #0            INITIALIZE...
      3070        STX VTOC          VTOC CHANGE FLAG,
      3080        STX PTR           FILE SECTOR COUNTER,
      3090        STX PTR+1
      3100        STX EOD           END OF DATA FLAG.
      3110        LDA #$C2
      3120        STA VY            INDEX FOR READING VTOC
      3130        LDA #$22
      3140        STA VTTRK         CURRENT TRACK FOR VTOC
      3150        LDA NSEC          NO OF SECTORS IN TESTFILE
      3160        STA CTR
      3170 *--------------------------------
      3180 *   READ T/S LIST INTO TSB, OR BUILD NEW ONE
      3190 *--------------------------------
      3200        DEX
      3210        STX NTSL          SET UP T/S LIST COUNTER
      3220 *   NTSL WILL BE ONE LESS THAN NO OF SECTORS USED FOR T/S LISTS
      3230        LDA TYP           NEW OR OLD FILE?
      3240        BNE TS2           NEW, GO BUILD T/S LIST
      3250        LDA TST           OLD, READ T/S LIST
      3260        STA TRK
      3270        LDA TSS
      3280        STA SECT
      3290 TS1    JSR TSIOB         SET UP IOB BUFF ADDR
      3300        LDA #1
      3310        STA OPER          READ
      3320        JSR R.W
      3330        BCC TS5           ALWAYS
      3340 TS2    JSR GETFREE       SECT FOR T/S LIST
      3350 TS3    >SET A4L,TSB      BUILD T/S LIST IN TSB
      3360        JSR ZBUFF         CLEAR IT FIRST (RETURNS Y=0)
      3370        LDA NTSL
      3380        BPL TS5           NEXT LINES ONLY ONCE
      3390        STY TYP
      3400 TS4    LDA TST,Y
      3410        STA (FILPTR),Y     SET TYPE & T/S FOR NEW FILE
      3420        INY
      3430        CPY #3
      3440        BNE TS4
      3450 TS5    LDY #3
      3460        JSR SAVTS         LABEL T/S LIST W/ITS OWN DISK LOCN
      3470        JSR INCPTR        BUMP FILE SECTOR COUNTER
      3480        INC NTSL          AND T/S LIST COUNTER
      3490        LDA #$0C
      3500        STA TSPTR         INIT T/S POINTER
      3510 *--------------------------------
      3520 *   WRITE A DATA SECTOR FROM BUFF
      3530 *--------------------------------
      3540 WD1    >SET A4L,BUFF
      3550        JSR ZBUFF         CLEAR DATA BUFFER (RETURNS Y=0)
      3560        LDX #$10          TEST MSG REPEATED 16X PER SECTOR
      3570        STX TYP
      3580        DEX
      3590 WD0    LDA TEXT,X        FILL BUFFER WITH TEXT
      3600        STA BUFF,Y
      3610        INY
      3620        DEX
      3630        BPL WD0
      3640        DEC TYP
      3650        BEQ WD2           BUFFER FULL
      3660        LDX #$0F
      3670        BPL WD0           ALWAYS
      3680 WD2    DEC CTR
      3690        BNE WD3
      3700        INC EOD           NO MORE DATA COMING
      3710 WD3    LDY TSPTR
      3720        LDA TSB,Y         GET NEXT T/S PAIR
      3730        BEQ WD4           NONE. GO FIND A FREE SECTOR
      3740        STA TRK           GOT IT. SAVE TRACK...
      3750        INY
      3760        LDA TSB,Y
      3770        STA SECT          AND SECTOR
      3780        INY          UPDATE T/S POINTER
      3790        STY TSPTR         AND SAVE IT, TOO.
      3800        BNE WD5           ALWAYS
      3810 WD4    JSR GETFREE       SECTOR FOR DATA
      3820        LDY TSPTR
      3830        JSR SAVTS         PUT T & S IN T/S LIST
      3840        STY TSPTR
      3850        LDA TST           AND IN IOB ALSO
      3860        STA TRK
      3870        LDA TSS
      3880        STA SECT
      3890 WD5    >SET BUFFAD,BUFF
      3900        LDA #2
      3910        STA OPER          WRITE
      3920        JSR R.W           DATA SECTOR TO DISK
      3930        JSR INCPTR        BUMP FILE SECTOR COUNTER
      3940        LDA EOD           END OF DATA?
      3950        BNE RC1           YES, GO RESTORE CATALOG
      3960        LDA TSPTR         END OF T/S LIST?
      3970        BNE WD1           NO, GO GET MORE DATA
      3980        LDA TSB+1         YES, CHECK FOR NEXT LIST
      3990        BEQ WD6           NONE. GO BUILD ONE
      4000        STA TRK           SAVE T/S OF NEXT LIST...
      4010        LDA TSB+2
      4020        STA SECT
      4030        JMP TS1           THEN GO READ IT.
      4040 WD6    JSR GETFREE       SECTOR FOR NEW T/S LIST
      4050        LDY #1
      4060        JSR SAVTS         SAVE LINKS IN CURRENT T/S LIST
      4070        DEY
      4080        STY OPER          WRITE
      4090        JSR SAVTSB        CURRENT T/S LIST TO DISK
      4100        JMP TS3           GO BUILD NEXT T/S LIST
      4110 *--------------------------------
      4120 SAVTS  LDA TST
      4130        STA TSB,Y
      4140        INY
      4150        LDA TSS
      4160        STA TSB,Y
      4170        INY
      4180        RTS
      4190 *--------------------------------
      4200 INCPTR INC PTR
      4210        BNE .1
      4220        INC PTR+1
      4230 .1     RTS
      4240 *--------------------------------
      4250 *   RESTORE CATALOG SECTORS TO DISK
      4260 *--------------------------------
      4270 RC1    LDY #$21          MOVE FILE LENGTH TO CATALOG ENTRY
      4280        LDA PTR
      4290        STA (FILPTR),Y
      4300        INY
      4310        LDA PTR+1
      4320        STA (FILPTR),Y
      4330        JSR DIRIOB        SETUP BUFF ADDR & TRK
      4340        LDA DIRSEC
      4350        STA SECT
      4360        LDA #2
      4370        STA OPER          WRITE
      4380        JSR R.W           DIRECTORY SECTOR TO DISK
      4390        LDY TSPTR         CLEAR REST OF T/S BUFFER
      4400        BEQ RC3
      4410        LDA #0
      4420 RC2    STA TSB,Y
      4430        INY
      4440        BNE RC2
      4450 RC3    JSR SAVTSB        SAVE T/S LIST TO DISK
      4460        LDA VTOC          VTOC CHANGE FLAG
      4470        BEQ RC4           SKIP VTOC IF UNCHANGED
      4480        LDA #0
      4490        STA VTOC          CLEAR CHANGE FLAG
      4500        >SET BUFFAD,VTOC
      4510        LDA #$11          TRACK $11, SECTOR 0
      4520        LDY #0
      4530        JSR CALL.RWTS.AY  WRITE VTOC TO DISK
      4540 RC4    LDA EOD
      4550        BNE EXIT
      4560        JMP FULL          DISK FULL ERROR IF NOT END OF DATA
      4570 EXIT   JMP COLDOS        EXIT TO BASIC
      4580 *--------------------------------
      4590 *   ROUTINE TO SCAN VTOC FOR NEXT FREE SECTOR
      4600 *--------------------------------
      4610 GETFREE LDY VY
      4620 V1     DEY
      4630        LDA VTOC,Y
      4640        CLC
      4650        DEY
      4660        ADC VTOC,Y        TRACK FULL?
      4670        BNE V2            NO, GO FIND FREE SECTOR
      4680        BCS V2            THEY COULD ADD TO ZERO!
      4690        DEY          YES, TRY NEXT ONE
      4700        DEY
      4710        DEC VTTRK
      4720        CPY #$42          DON'T LOOK BELOW TRK 3
      4730        BNE V1
      4740        LDA #0
      4750        STA EOD           CLR FLAG TO FORCE DISK FULL ERROR
      4760        JMP RC1           EXIT AFTER RESTORING CATALOG SECTORS
      4770 V2     LDA VTOC,Y        MOVE BIT MAP TO ROL BUFFER
      4780        STA VB1
      4790        INY
      4800        LDA VTOC,Y
      4810        STA VB2
      4820        INY
      4830        STY VY            SAVE Y FOR NEXT TIME
      4840        LDX #$0F          SECTOR
      4850 V5     LDA #$80          MASK BIT
      4860        CLC
      4870 V3     ROL VB2
      4880        ROL VB1
      4890        BCS V4            FREE SECTOR FOUND
      4900        DEX          NOT  FOUND, TRY NEXT ONE
      4910        LSR
      4920        BCC V3
      4930        BCS V5            ALWAYS
      4940 V4     STX TSS           SAVE SECTOR
      4950        DEY
      4960        CPX #8            USE 2ND MAP BYTE?
      4970        BCC V6            NO, USE 1ST
      4980        DEY
      4990 V6     EOR #$FF          COMPLEMENT AC
      5000        AND VTOC,Y        CLEAR BIT = SECTOR USED
      5010        STA VTOC,Y        UPDATE VTOC
      5020        LDA #1
      5030        STA VTOC          SET CHANGE FLAG
      5040        LDA VTTRK
      5050        STA TST           SAVE TRACK
      5060        RTS
      5070 *--------------------------------
      5080 *   IOB SET-UPS USED MORE THAN ONCE
      5090 *--------------------------------
      5100 DIRIOB LDA #$11
      5110        STA TRK
      5120        >SET BUFFAD,DBUFF
      5130        RTS
      5140 VTIOB  >SET BUFFAD,VTOC
      5150        LDA #0
      5160        STA SECT
      5170        RTS
      5180 TSIOB  >SET BUFFAD,TSB
      5190        RTS
      5200 *--------------------------------
      5210 *   ROUTINE TO SAVE T/S LIST TO DISK
      5220 *--------------------------------
      5230 SAVTSB >SET BUFFAD,TSB
      5240        LDA TSB+3    TRACK
      5250        LDY TSB+4    SECTOR
      5260 *      JMP CALL.RWTS.AY    *** FALL INTO IT ***
      5270 *--------------------------------
      5280 *   RWTS CALLER.  EXITS THRU DOS IF ERROR OCCURS.
      5290 *--------------------------------
      5300 CALL.RWTS.AY
      5310        STA TRK
      5320        STY SECT
      5330 R.W    JSR GETIOB
      5340        JSR RWTS
      5350        LDA #4       IRQ OFF, DECIMAL OFF
      5360        STA STATUS
      5370        BCS .1       R/W ERROR
      5380        RTS
      5390 .1     LDX RETCOD
      5400        CPX #$10
      5410        BEQ ANYERR   $04 = WRITE PROTECT ERROR
      5420        ASL          $08 = I/O ERROR
      5430        BNE ANYERR   ...ALWAYS
      5440 *--------------------------------
      5450 FULL   LDA #9
      5460        .HS 2C
      5470 LOCK   LDA #$0A
      5480        .HS 2C
      5490 SYNERR LDA #$0B
      5500        .HS 2C
      5510 TYPERR LDA #$0D
      5520 ANYERR PHA
      5530        JSR CROUT
      5540        JSR CROUT
      5550        PLA
      5560        TAX
      5570        JSR DOSERR
      5580        JMP COLDOS        EXIT TO BASIC
      5590 *--------------------------------
      5600 *   Dummy data for demonstration
      5610 *--------------------------------
      5620 NSEC   .HS 32       number of sectors in demo file
      5630 TEXT   .HS 8D
      5640        .AS -/.TSET A SI SIHT/
      5650 *--------------------------------
      5660        .LIF

Strange Decimal-to-Binary Conversion | Bob Sander-Cederlof

Back in the 1950's I worked for a few years with the Bendix G-15D Computer. This machine was the ultimate personal computer of its day. The operator console consisted of an IBM Executive typewriter, with a few added switches. Mass storage was supplied by paper tape, both in loose coils and in cassettes (roughly the physical size of our present day VHS video cassettes). You got 2176 words of RAM, each with 29 bits, on a rotating magnetic drum. Let's see...that is less than 8K bytes. The three two-word registers and one one-word register also resided on the magnetic drum. The hardware instruction set included multiply and divide, and also some sophisticated logical field extraction operations. Speed? Well, it was plenty fast enough for its day. The basic unit, as described above, cost $50,000. In those days that was a very good price for a real computer, and engineering groups all over the country bought them with alacrity. You could also add a magnetic tape unit, a Calcomp X-Y plotter, a Digital Differential Analyzer, and more.

Believe it or not, during the entire lifetime of the product, which was over ten years, nobody ever wrote an assembler for the G-15. You had to program it either in raw hex, in a decimalized translation of the raw hex, or in an interpretive language. (We did eventually get the equivalent of a mini-assembler, with the auspicious name of "Altran".) The various intepretive languages supplied floating point math and simplified I/O, but it still looked like raw machine language. Everything was done with numbers, you could not use symbolic names for opcodes or operands.

There was one significant exception. In the early 60's a group of geniuses created a version of Algol for this machine. The compiler consisted of eight magazines full of paper tape! In case you never heard of Algol, you can think of it as the predecessor of Pascal.

In the middle 60's Control Data Corporation bought out the computer division of Bendix, and a few West Coast salesmen got the bright idea that these old beasts could get a second life in high schools and Junior Colleges. Part of my job at that time was to train high school teachers in using the G-15 and programming with one of the interpreters. Some of you may remember the name of Bob Albrecht, from the late 70's, the early days of Dr. Dobbs; he was also quite active in this project of setting up high schools with G-15s.

Well, anyway, you could do a lot with just a little back in those days. I stumbled over a pile of old G-15 manuals a few weeks ago, and out popped this fascinating decimal-to-binary conversion subroutine. I decided it was worth the effort to translate it into 6502 code. It converts a string of seven decimal digits in packed BCD form (or eight if you select the option in line 1050) to a 32-bit (29 in the G-15) binary value.

In my program I simulate the three two-word registers with four-byte variables named PLIER, CAND, and PROD. It is not as many bits (32 bersus 58), but this program only needs 32 bits in each register. The code for the conversion is shown below in lines 1680-1960. When you realize that the EXTRACT and MULTIPLY subroutines I call here were simple machine language instructions in the G-15, you can see that the program was very compact in that machine. The EXTRACT subroutine simulates the G-15 instruction, which uses a binary mask to produce two results at once. The PROD (product) register is ANDed with the mask and the result stored in the CAND (multiplicand) register. After that, everywhere there are 1-bits in the mask the corresponding bits are cleared in the PROD register. For example, start with PROD = $12345678 and MASK = $0F0F0FFF. Afterwards CAND = $02040678 and PROD = $10305000.

The G-15 multiply instruction was unique, in that it could be told how many bits to multiply. My subroutine simulates that property by using the X-register to specify how many times to loop around, once for each bit. MULTIPLY adds the CAND*PLIER partial products to the PROD register.

There a a few secrets hidden in the value assembled at FACTOR. To simplify and speed up my MULTIPLY subroutine, FACTOR contains the 1's complement of the actual factor. The actual factor for eight digits is $AAC9F400. This is used in pieces: four bits = $A, three bits = $5, six bits = $19, and nine bits = $7D. Note that $A is 10, $5 is 10/2, $19 is 250 or 100/4, and $7D is 125 or 1000/8. Is it starting to make sense now?

If you look at the four masks, you will notice that the F's correspond to BCD digit positions. Think of the digit positions as D7 through D0, left to right. MASK0 causes digit D7 to multiplied by ten; MASK1 causes digits D7, D6, D4, and D1 to be multiplied by ten; MASK2 causes digits D7, D6, D5, and D2 to be multiplied by 100; and MASK3 causes digits D7 through D3 to be multiplied by 1000. The result is the same as D7*10^7 + D6*10^6 + ... + D1*10 + D0.

           D7:  10*10*100*1000 = 10^7
           D6:     10*100*1000 = 10^6
           D5:        100*1000 = 10^5
           D4:     10    *1000 = 10^4
           D3:           *1000 = 10^3
           D2:       *100      = 10^2
           D1:    *10          = 10^1
           D0:   untouched     = 10^0

I hope I haven't lost you. If I have, please go back and read it again. I think it is really worth the effort! The idea of using an unfinished multiply simply MUST have other applications....

My demonstration program starts in line 1130. It allows you to type in a decimal number, and then prints the converted value in hex. Lines 1260-1570 read your input line and pack up the digits as BCD in the PROD register. Lines 1590-1660 print the four bytes of PROD in hex.

      1000 *SAVE FUNNY.CONVERT.1
      1010 *--------------------------------
      1020 *   CONVERT 7- OR 8-DIGIT PACKED BCD VALUE
      1030 *      TO BINARY
      1040 EIGHT  .EQ 1        =1 FOR 8 DIGITS, =0 FOR 7 DIGITS
      1050        .LIST CON
      1060 *--------------------------------
      1070 MON.RDLINE .EQ $FD67
      1080 MON.PRBYTE .EQ $FDDA
      1090 MON.COUT   .EQ $FDED
      1100 INBUF      .EQ $200
      1110 MON.PROMPT .EQ $33
      1120 *--------------------------------
      1130 T
      1140 .1     JSR GET.BCD.VALUE
      1150        BCC .2       FINISHED
      1160        JSR DISPLAY.PROD
      1170        LDA #"="
      1180        JSR MON.COUT
      1190        LDA #"$"
      1200        JSR MON.COUT
      1210        JSR FUNNY.CONVERSION
      1220        JSR DISPLAY.PROD
      1230        JMP .1
      1240 .2     RTS
      1250 *--------------------------------
      1260 GET.BCD.VALUE
      1270        LDA #"="
      1280        STA MON.PROMPT
      1290        JSR MON.RDLINE
      1300        CPX #1       SEE IF EMPTY LINE
      1310        BCC .4       ...YES
      1320        LDX #4       CLEAR PROD FIRST
      1330        LDA #0
      1340 .1     STA PROD-1,X
      1350        DEX
      1360        BNE .1
      1370 *---ACCUMULATE NUMBER------------
      1380 .2     LDA INBUF,X
      1390        EOR #"0"
      1400        CMP #10
      1410        BCS .4
      1420        ASL          POSITION IN HIGH NYBBLE
      1430        ASL
      1440        ASL
      1450        ASL
      1460        LDY #3
      1470 .3     ROL
      1480        ROL PROD+3
      1490        ROL PROD+2
      1500        ROL PROD+1
      1510        ROL PROD
      1520        DEY
      1530        BPL .3
      1540        INX
      1550        CPX #8
      1560        BCC .2
      1570 .4     RTS
      1580 *--------------------------------
      1590 DISPLAY.PROD
      1600        LDY #0
      1610 .2     LDA PROD,Y
      1620        JSR MON.PRBYTE
      1630        INY
      1640        CPY #4
      1650        BCC .2
      1660        RTS
      1670 *--------------------------------
      1680 FUNNY.CONVERSION
      1690        LDY #2       ONLY NEED 3 BYTES OF FACTOR
      1700 .1     LDA FACTOR,Y
      1710        STA PLIER,Y
      1720        DEY
      1730        BPL .1
      1740 *--------------------------------
      1750   .DO EIGHT
      1760        LDX #MASK0
      1770        JSR EXTRACT
      1780        LDX #4       MULTIPLY 4 CYCLES
      1790        JSR MULTIPLY
      1800   .FIN
      1810 *--------------------------------
      1820        LDX #MASK1
      1830        JSR EXTRACT
      1840        LDX #3       MULTIPLY 3 CYCLES
      1850        JSR MULTIPLY
      1860 *--------------------------------
      1870        LDX #MASK2
      1880        JSR EXTRACT
      1890        LDX #6       MULTIPLY 6 CYCLES
      1900        JSR MULTIPLY
      1910 *--------------------------------
      1920        LDX #MASK3
      1930        JSR EXTRACT
      1940        LDX #9       MULTIPLY 9 CYCLES
      1950        JMP MULTIPLY
      1960 *--------------------------------
      1970 EXTRACT
      1980        LDY #3
      1990 .1     LDA PROD,Y
      2000        AND MASKS,X
      2010        STA CAND,Y
      2020        EOR PROD,Y
      2030        STA PROD,Y
      2040        DEX
      2050        DEY
      2060        BPL .1
      2070        RTS
      2080 *--------------------------------
      2090 MULTIPLY
      2100 .1     LSR CAND     MSBYTE
      2110        ROR CAND+1
      2120        ROR CAND+2
      2130        ROR CAND+3   LSBYTE
      2140        ASL PLIER+3  LSBYTE
      2150        ROL PLIER+2
      2160        ROL PLIER+1
      2170        ROL PLIER    MSBYTE
      2180        BCS .3       ...DO NOT ADD 'CAND
      2190        LDY #3
      2200 .2     LDA PROD,Y
      2210        ADC CAND,Y
      2220        STA PROD,Y
      2230        DEY
      2240        BPL .2
      2250 .3     DEX
      2260        BNE .1
      2270        RTS
      2280 *--------------------------------
      2290 PLIER  .BS 4        HI-BYTE FIRST
      2300 CAND   .BS 4
      2310 PROD   .BS 4
      2320 *--------------------------------
      2330 MASKS
      2340   .DO EIGHT
      2350 MASK0  .EQ *-MASKS+3
      2360        .HS F0.00.00.00
      2370   .FIN
      2380 MASK1  .EQ *-MASKS+3
      2390        .HS FF.0F.00.F0
      2400 MASK2  .EQ *-MASKS+3
      2410        .HS FF.F0.0F.00
      2420 MASK3  .EQ *-MASKS+3
      2430        .HS FF.FF.F0.00
      2440 *--------------------------------
      2450   .DO EIGHT
      2460 FACTOR .HS 55.36.0B.FF   10, 10, 100, 1000
      2470   .ELSE
      2480 FACTOR .HS 53.60.BF.FF   10, 100, 1000
      2490   .FIN
      2500 *--------------------------------

Getting a Pointer from a Handle | Bob Sander-Cederlof

Did you read "Let's Get a Handle on this Memory", by Ken Kashmarek in the October 1987 Call APPLE, pages 61-63? Ken ably discusses what "Handles" and "Pointers" are in the Apple IIgs world, and gives some subroutines to use for finding data pointed to by them.

Handles and Pointers are part of a hierarchy of addresses that enable you to find things the Memory Manager and others have hidden and moved around in RAM. For example, the Memory Manager gives you a Handle, which is a 24-bit address pointing to a Master Pointer, which is in turn a 24-bit address pointing to your Memory block. The Memory manager is free to move the actual memory block around, as long as it keeps the master pointer updated; you can always find out where the memory block is, because you have the handle with which you can look up the current location.

Ken gave some code for using handles to find memory, and indeed to find other data in the Master Pointer area. Of course code like this has many more applications, as it is just basically a matter of picking up a 32-bit value at a known address, or at an offset from that known address.

How did you guess? I also have written some similar routines! My code is a teensy bit shorter than Ken's, and has the additional advantage of not using any page-zero memory.

I followed the same ground rules as Ken: I assume you are in full 16-bit Native mode (m=x=0), and that the handle address is in the A- and X-registers. The low 16-bits of the handle are in the X-register, and the high 16 are in the A-register. (Of course, addresses in the IIgs are really only 24-bits long, so the high half of the A-register is ignored in the following code.) The result, the 32-bits accessed via the handle, are returned in the A- and X-registers. I wrote two versions, one for inline use, the other a general purpose subroutine.

My first version could be written as a macro, allowing any two pairs of bytes to be picked up in A and X:

                   .MA PICKUP
                   PHB             Save Data Bank Reg
                   PHA             Push hi-A, then lo-A
                   PLB             Get bank where handle points
                   TXY             Get rest of handle in Y-reg
                   LDX >]1,Y       Get pair of bytes
                   LDA >]2,Y       Get another pair of bytes
                   PLB             Pop of what was hi-A
                   PLB             Restore B-register
                   .EM

Use with >PICKUP 0,2 to get first four bytes, the first of these being at the address in the handle. >PICKUP 8,10 will get four bytes starting at 8th. >PICKUP 2,8 will get bytes 2 and 3 in X, 8 and 9 in A.

In the listing which follows, lines 1140-1210 are the same as the macro code above. The program demonstrates using it by printing out the address contained in the four bytes pointed to by a particular handle. The handle in my example contains the address $E10001, so the three bytes beginning at $E10001 are printed out.

Lines 1370-1620 are similar in function, but written as a general subroutine. You can call the subroutine at HANDPTR to get the first four bytes the handle points to, or you can set Y to any offset value and call the subroutine at HANDPTR2 to get an offset group of four bytes.

If you intend to use this subroutine in a larger program that occupies more than one bank, you might want to change the RTS in line 1610 to an RTL, and call the subroutine with a JSL rather than a JSR instruction.

I toyed with the idea of a similar subroutine written in purely 6502 code. What if we called a subroutine with the hi-half of a 16-bit address in the A-register, and the lo-half in the X-register? What code would it take to pickup a two-byte value at an offset from that address? Here is what I came up with, using two bytes of page zero memory:

          HANDPTR  LDY #0
          HANDPTR2 STX ZP
                   STA ZP+1
                   LDA (ZP),Y
                   TAX
                   INY
                   LDA (ZP),Y
                   RTS

The only other pure 6502 routine I thought of involved self-modifying code, storing the address inside two LDA instructions.

      1000 *SAVE S.HANDLES
      1010        .OP 65816
      1020 *--------------------------------
      1030 T
      1040        CLC
      1050        XCE
      1060        REP #$30
      1070 *--------------------------------
      1080        LDA HANDLE+2
      1090        LDX HANDLE
      1100 *--------------------------------
      1110 *   Standard code sequence to get pointer into A,X
      1120 *      from a handle in A,X -- 12 bytes.
      1130 *--------------------------------
      1140        PHB          Save Data Bank Register
      1150        PHA          Push hi-A (GARBAGE), then lo-A
      1160        PLB          lo-A is bank where handle points
      1170        TXY          Use 16-bits of address in Y-register
      1180        LDX >0,Y     Get first two bytes handle pointed at
      1190        LDA >2,Y     Get next two bytes handle pointed at
      1200        PLB          pop original hi-A
      1210        PLB          Restore Data Bank Register
      1220 *--------------------------------
      1230        STA POINTER+2
      1240        STX POINTER
      1250 *--------------------------------
      1260        SEC          Print the 24-bit address returned
      1270        XCE
      1280        JSR $FDDA
      1290        LDA POINTER+1
      1300        JSR $FDDA
      1310        LDA POINTER
      1320        JMP $FDDA
      1330 *--------------------------------
      1340 POINTER    .BS 4
      1350 HANDLE     .DA <$E10001
      1360 *--------------------------------
      1370 *   More general subroutine for getting four bytes of data
      1380 *      from a block of memory pointed at by address in A,X
      1390 *      ( 18 bytes )
      1400 *
      1410 *   Use JSR HANDPTR to get first four bytes.
      1420 *   Use LDY ##n and JSR HANDPTR2
      1430 *      to get four bytes starting at nth byte.
      1440 *   <<Note this subroutine assumes full 16-bit mode>>
      1450 *--------------------------------
      1460 HANDPTR
      1470        LDY ##0000
      1480 HANDPTR2
      1490        PHB          Save Data Bank Register
      1500        PHA          Push hi-A (GARBAGE), then lo-A
      1510        PLB          lo-A is bank where handle points
      1520        PHX          Push 16-bit address of handle on stack
      1530        LDA (1,S),Y  Get 2 bytes at (handle),Y
      1540        TAX          ...save 'em
      1550        INY          Point to next two bytes
      1560        INY
      1570        LDA (1,S),Y  Get 2 bytes following the other two
      1580        PLY          Pop the handle address
      1590        PLB          pop original hi-A
      1600        PLB          Restore Data Bank Register
      1610        RTS
      1620 *--------------------------------

Converting BCD to Binary, Packing Fields | Bob Sander-Cederlof

I have been working on some hardware recently which includes a date and time chip. The chip produces the year, month, day, hour, minute, and second as six BCD values. That is, each value is coded as an 8-bit byte, but not in binary. The first four bits are the ten's digit of the decimal value, and the other four bits are the unit's digit. This is called BCD, for Binary-Coded-Decimal.

This is nice for display purposes, but not so nice for packing into a binary format. My operating system needs the date and time packed into four bytes. (ProDOS does it in much the same way.) The end result will be two 16-bit values, looking like this:

           YYYYYYYMMMMDDDDD
           hhhhhmmmmmmsssss

YYYYYYY means a seven bit field for the year, with a value between 0 and 99; MMMM is the month, 1-12; DDDDD is the day of month, 1-31; hhhhh is the hour of the day, 0-23; mmmmmm is the minute, 0-59; and sssss is for seconds, but only runs from 0 to 29. There are not quite enough bits, so "sssss" is equal to seconds/2. This just happens to be the way date and time are stored in MS/DOS file directory entries, by the way.

To start with, I needed an efficient way to convert a BCD byte into a binary value. Since I was working on a 65816-based system, I coded with that processor in mind. The listing which follows shows three different versions of this subroutine. The third one is written to run in a plain-vanilla 6502, in case that is all you have.

The first version, lines 1020-1210, takes 20 bytes. It uses the stack for temporary storage, and works by isolating the ten's digit, calculating the binary value of ten times the ten's digit, and adding the unit's digit. I used the Stack-Relative addressing mode here, so it does require the 65816 or 65802 processor. It will work in either Native or Emulation mode. If you are in Native mode, the m-bit must be 1 so the A-register works as an 8-bit register.

The second version, lines 1220-1400, is only 18 bytes. I got a little trickier, and took advantage of the fact that 10x is equal to 16x-6x. This also uses the Stack-Relative address mode, so the same restrictions apply as with the first version.

The third version, lines 1410-1590, which will run in a 6502 or 65C02, takes 22 bytes as shown. It requires two bytes for temporary storage. (I include these two bytes in the count.) If you put the two temp bytes in page zero, it will shorten the code by four bytes (still counting the temp bytes) making it just as short as the shortest 65816 version! Another shortening option would require the subroutine to be in RAM: change lines 1530 and 1540 to use immediate mode, and store the T1 and T2 values directly into the address fields of these two instructions. This would also make an 18-byte subroutine, but with the stigma of being self-modifying code.

I wrote a test routine, to be sure my subroutines worked correctly. Lines 1630-1800 run through all 100 possible values, comparing the converted result with the expected result. If there are any discrepancies, I print out the BCD and Binary values. Naturally, they all worked perfectly and I got no printout. (When that happens it is a good idea to purposely insert a bug in the subroutine being tested to make sure the test routine itself is working!)

The test routine uses a STZ opcode, which is on the 65C02 and up, but not on the 6502. Substitute LDA #0, STA 0 is you have a 6502. The test routine counts from 0 to 99 in decimal mode in the X- and A-registers, and from 0 to $63 in binary mode in page zero location $00.

Lines 1810-2180 call on one of the BCD-to-BIN converters to convert the date and time values, and then use 6502-compatible code to pack it all into the required four-byte format. I used a sample date and time in lines 2200-2280.

      1000        .OP 65816
      1010 *SAVE S.CONV.BCD.TO.BIN
      1020 *--------------------------------
      1030 *   Convert BCD to BIN by parts
      1040 *--------------------------------
      1050 CONV.BCD.TO.BIN.1
      1060        PHA
      1070        AND #$0F     ISOLATE UNITS DIGIT
      1080        PHA
      1090        EOR 2,S      ISOLATE TENS DIGIT
      1100        LSR          TENS*8
      1110        PHA
      1120        LSR
      1130        LSR          TENS*2
      1140        ADC 1,S      TENS*10
      1150        ADC 2,S      TENS*10+UNITS
      1160        STA 3,S      save converted value
      1170        PLA          POP off temps
      1180        PLA
      1190        PLA          get converted result
      1200        RTS          RETURN
      1210 Z.A    .EQ *-CONV.BCD.TO.BIN.1
      1220 *--------------------------------
      1230 *   Convert BCD to BIN by subtraction
      1240 *      10a+b = 16a+b - 6a
      1250 *--------------------------------
      1260 CONV.BCD.TO.BIN.2
      1270        PHA          Save 16*a+b
      1280        AND #$F0     Isolate 16*a
      1290        LSR          make it 8*a
      1300        LSR          make it 4*a
      1310        PHA          Save 4*a
      1320        LSR          make 2*a
      1330        ADC 1,S      4a+2a = 6a
      1340        SBC 2,S      6a - (16a+b) - 1 (because carry was clear)
      1350        EOR #$FF     (16a+b) - 6a
      1360        STA 2,S      Save in stack
      1370        PLA          pop off temp value
      1380        PLA          Get binary result
      1390        RTS          RETURN
      1400 Z.B    .EQ *-CONV.BCD.TO.BIN.2
      1410 *--------------------------------
      1420 *   6502 Version
      1430 *   Convert BCD to BIN by subtraction
      1440 *      10a+b = 16a+b - 6a
      1450 *--------------------------------
      1460 CONV.BCD.TO.BIN.3
      1470        STA T1       Save 16*a+b
      1480        AND #$F0     Isolate 16*a
      1490        LSR          make it 8*a
      1500        LSR          make it 4*a
      1510        STA T2       Save 4*a
      1520        LSR          make 2*a
      1530        ADC T2       4a+2a = 6a
      1540        SBC T1       6a - (16a+b) - 1 (because carry was clear)
      1550        EOR #$FF     (16a+b) - 6a
      1560        RTS          RETURN
      1570 T1     .BS 1
      1580 T2     .BS 1
      1590 Z.C    .EQ *-CONV.BCD.TO.BIN.3
      1600 *--------------------------------
      1610 *   Test Conversion Subroutine
      1620 *--------------------------------
      1630 U      STZ 0
      1640        LDX #0
      1650 .1     TXA
      1660        JSR CONV.BCD.TO.BIN.1
      1670        CMP 0
      1680        BEQ .2
      1690        JSR $FDDA
      1700        TXA
      1710        JSR $FDDA
      1720 .2     TXA
      1730        INC 0
      1740        SED
      1750        CLC
      1760        ADC #1
      1770        CLD
      1780        TAX
      1790        BNE .1
      1800        RTS
      1810 *--------------------------------
      1820 *   Convert BCD Date/Time to Packed Binary
      1830 *--------------------------------
      1840 S
      1850        LDX #5
      1860 .1     LDA BCD.DATE.AND.TIME,X
      1870        JSR CONV.BCD.TO.BIN.2
      1880        STA BIN.DATE.AND.TIME,X
      1890        DEX
      1900        BPL .1
      1910 *---Pack converted time----------
      1920        LSR SEC      000SSSSS  Sec/2
      1930        LDA MIN      00MMMMMM
      1940        ASL          0MMMMMM0
      1950        ASL          MMMMMM00
      1960        ASL          M.MMMMM000
      1970        ROL HOUR     00HHHHHM
      1980        ASL          M.MMMM0000
      1990        ROL HOUR     0HHHHHMM
      2000        ASL          M.MMM00000
      2010        ORA SEC      MMMSSSSS
      2020        STA HMS
      2030        LDA HOUR
      2040        ROL          HHHHHMMM
      2050        STA HMS+1    HHHHHMMM
      2060 *---Pack converted date----------
      2070        LDA MONTH    0000mmmm
      2080        ASL          000mmmm0
      2090        ASL          00mmmm00
      2100        ASL          0mmmm000
      2110        ASL          mmmm0000
      2120        ASL          m.mmm00000
      2130        ORA DAY      mmmddddd
      2140        STA YMD
      2150        LDA YEAR     0yyyyyyy
      2160        ROL          yyyyyyym
      2170        STA YMD+1
      2180        RTS
      2190 *--------------------------------
      2200 *   Date and Time in BCD Format
      2210 *--------------------------------
      2220 BCD.DATE.AND.TIME
      2230        .HS 87       Year
      2240        .HS 12       Month
      2250        .HS 17       Day
      2260        .HS 09       Hour
      2270        .HS 57       Minute
      2280        .HS 30       Second
      2290 *--------------------------------
      2300 BIN.DATE.AND.TIME
      2310 YEAR   .BS 1        TEMPS, receive binary values
      2320 MONTH  .BS 1
      2330 DAY    .BS 1
      2340 HOUR   .BS 1
      2350 MIN    .BS 1
      2360 SEC    .BS 1
      2370 *--------------------------------
      2380 *   Date and Time in Packed Binary Format
      2390 *--------------------------------
      2400 YMD    .BS 2        YYYYYYY.MMMM.DDDDD
      2410 HMS    .BS 2        HHHHH.MMMMMM.SSSSS  SSSSS=Sec/2
      2420 *--------------------------------
      2430        .LIF

Key Edit Program | Bob Boughner & Bob S-C

BONUS PROGRAM (not printed in the original newsletter).

      900        .TI 76,Key Edit Program by Bob Boughner & Bob S-C......11-19-87.......
      1000        .LIST CON
      1010 HAVE.PAD   .EQ 0    =0 IF NO PAD, =1 IF PAD PRESENT
      1020        .OP 65816
      1030 *--------------------------------
      1040 * SAVE S.KEY.EDIT
      1050 *--------------------------------
      1060        .OR $5000
      1070        .TF KEY.EDIT
      1080 *--------------------------------
      1090 * VARIABLES NEEDED FOR LOADING
      1100 * KEY.EDIT
      1110 *--------------------------------
      1120 DOS.IO.HOOK         .EQ $3EA
      1130 BLD.DOS.BUFRS       .EQ $A7D4
      1140 DOS.BUFR.LOC        .EQ $9D00
      1150 KSWL                .EQ $38
      1160 KSWH                .EQ $39
      1170 COL80               .EQ $C300
      1180 MON.RESET           .EQ $3F2
      1190 PWRUP               .EQ $3F4
      1200 *--------------------------------
      1210 BGN    LDA /RESET.PTCH
      1220        CMP MON.RESET+1
      1230        BEQ .6       ALREADY SETUP
      1240 *---Copy BODY to $9900-9BFF------
      1250        LDY #0
      1260 .1     LDA IMAGE,Y
      1270        STA $9900,Y
      1280        LDA IMAGE+256,Y
      1290        STA $9A00,Y
      1300        LDA IMAGE+512,Y
      1310        STA $9B00,Y
      1320        INY
      1330        BNE .1
      1340 *---Clear command buffer---------
      1350        JSR CLEAR.BUFFER
      1360 *---Set up RESET vector----------
      1370        LDY #1
      1380 .5     LDA MON.RESET,Y   POINT MY RESET AT CURRENT
      1390        STA NORM.RESET,Y
      1400        LDA MY.RESET,Y    POINT RESET AT MY PATCH
      1410        STA MON.RESET,Y
      1420        DEY
      1430        BPL .5
      1440        LDA /RESET.PTCH^$A500   VALIDATE THE VECTOR
      1450        STA PWRUP
      1460 *---Drop DOS buffers 4 pages-----
      1470        SEC
      1480        LDA DOS.BUFR.LOC+1
      1490        SBC #4
      1500        STA DOS.BUFR.LOC+1
      1510        JSR BLD.DOS.BUFRS
      1520 *---Install my input hook--------
      1530        LDA #HOOK
      1540        LDY /HOOK
      1550        STA KSWL
      1560        STY KSWH
      1570        JSR DOS.IO.HOOK
      1580 .6     RTS
      1590 *--------------------------------
      1600 T
      1610 *---Copy BODY to $9900-9BFF------
      1620        LDY #0
      1630 .1     LDA IMAGE,Y
      1640        STA $9900,Y
      1650        LDA IMAGE+256,Y
      1660        STA $9A00,Y
      1670        LDA IMAGE+512,Y
      1680        STA $9B00,Y
      1690        INY
      1700        BNE .1
      1710 *---Clear command buffer---------
      1720        JSR CLEAR.BUFFER
      1730 *---Setup RESET Vector-----------
      1740        LDY #1
      1750 .5     LDA MY.RESET,Y    POINT RESET AT MY PATCH
      1760        STA MON.RESET,Y
      1770        DEY
      1780        BPL .5
      1790        LDA /RESET.PTCH^$A500   VALIDATE THE VECTOR
      1800        STA PWRUP
      1810 *---Install my input hook--------
      1820        LDA #HOOK
      1830        LDY /HOOK
      1840        STA KSWL
      1850        STY KSWH
      1860        JSR DOS.IO.HOOK
      1870 .6     RTS
      1880 *--------------------------------
      1890 MY.RESET .DA RESET.PTCH
      1900 *--------------------------------
      1910 *  VARIABLES AND CONSTANTS
      1920 *--------------------------------
      1930 MON.ADVANCE         .EQ $FBF4
      1940 MON.VTAB            .EQ $FC22
      1950 MON.RDKEY           .EQ $FD0C
      1960 MON.CLREOP          .EQ $FC42
      1970 MON.ESC             .EQ $FD2F
      1980 MON.COUT            .EQ $FDED
      1990 *--------------------------------
      2000 KEYIN.40            .EQ $FD1B
      2010 KEYIN.80            .EQ $C305
      2020 *--------------------------------
      2030 INBUF               .EQ $200
      2040 COL.STATE           .EQ $C01F
      2050 KEY.STATE           .EQ $C025
      2060 CV                  .EQ $25
      2070 CH40                .EQ $24
      2080 CH80                .EQ $57B
      2090 WNDWDTH             .EQ $21
      2100 WNDBTM              .EQ $23
      2110 *--------------------------------
      2120 IMAGE  .PH $9900
      2130 *--------------------------------
      2140 *   The input hook at KSWL,H branches here whenever
      2150 *      RDKEY is called.
      2160 *--------------------------------
      2170 HOOK   BRA .2            <<<MODIFIED TO SKIP OR NOT SKIP
      2180 .1     JMP TRUE.KEYIN             THIS JMP>>>
      2190 .2     CPX LNGTH         IS X POSITION GREATER THAN MY SAVED LENGTH?
      2200        BCC .3            NO. MUST BELONG TO ME
      2210        BNE .1            IF NOT EQUAL, THEN IT IS NOT MINE
      2220 *--------------------------------
      2230 .3     PHA               SAVE THE CURRENT SCRN CHAR
      2240        TXA               AT BEGINNING OF LINE?
      2250        BNE .5            NO.
      2260 *---Save line start position-----
      2270        LDA CV            GET POSITION OF LINE START AND SAVE
      2280        STA BOL
      2290        LDA CH40          ASSUME 40 COLUMNS
      2300        BIT COL.STATE     IS IT 40 OR 80 COLS?
      2310        BPL .4            ...40 COLUMNS
      2320        LDA CH80          ...80 COLUMMS
      2330 .4     STA BOC
      2340 .5     PLA               RETRIEVE SAVED SCREEN CHARACTER
      2350        JSR TRUE.KEYIN    GET A CHR FROM THE NORMAL INPUT ROUTINE
      2360        STZ HOOK+1        SWITCH TO LET MON.RDKEY FUNCTION
      2370 .6     JSR PROCESS.CHAR
      2380        JSR MON.RDKEY
      2390        BRA .6            NORMAL CHARS BUST THE LOOP
      2400 *--------------------------------
      2410 PROCESS.CHAR
      2420        STA CURRCHAR
      2430        LDY #-4
      2440 .1     INY
      2450        INY
      2460        INY
      2470        INY
      2480        LDA CMDTBL,Y
      2490        BEQ .2       ...END OF CMDTBL
      2500        CMP CURRCHAR
      2510        BNE .1       ...TRY NEXT ENTRY
      2520        LDA KEY.STATE
      2530        AND #%11010011    ONLY OA,SA,PAD,CTRL,SHIFT
      2540        CMP CMDTBL+1,Y
      2550        BNE .1       ...TRY NEXT ENTRY
      2560 .2     LDA CMDTBL+3,Y
      2570        PHA
      2580        LDA CMDTBL+2,Y
      2590        PHA
      2600        RTS
      2610 *--------------------------------
      2620        .MA CMD
      2630        .DA #$]1,#$]2,]3-1
      2640        .EM
      2650 *--------------------------------
      2660 CMDTBL
      2670   >CMD 88,00,BAKSPC      LEFT ARROW
      2680   >CMD 88,80,LINE.START  OA-LEFT ARROW
      2690   >CMD 95,00,FORWD       RIGHT ARROW
      2700   >CMD 95,80,END.OF.LINE OA-RIGHT ARROW
      2710   >CMD FF,00,DELCHR      DELETE
      2720   >CMD FF,80,DELALL      OA-DELETE
      2730   >CMD FF,02,DELEOL      CTRL-DELETE
      2740   >CMD FF,03,DELBOL      CTRL-SHIFT-DELETE
      2750   >CMD FF,40,CLEAR.BUFFER  SA-DELETE
      2760   .DO HAVE.PAD
      2770   >CMD AE,90,DELCUR      OA-PAD-"."
      2780   >CMD B0,90,INS.TOG     OA-PAD-"0"
      2790   .ELSE
      2800   >CMD AE,80,DELCUR      OA-"."
      2810   >CMD AC,80,INS.TOG     OA-","
      2820   .FIN
      2830   >CMD 8B,00,UP          UP ARROW
      2840   >CMD 8A,00,DOWN        DOWN ARROW
      2850   >CMD 89,00,TAB.FWD     TAB
      2860   >CMD 89,80,TAB.BAK     OA-TAB
      2870   >CMD 00,00,NORM.CHR   any other
      2880 *--------------------------------
      2890 BAKSPC TXA               AT LINE START?
      2900        BEQ RTS.1         YES, GET THE NEXT CHR
      2910        DEX               NO, BACKUP ONE SPACE
      2920        LDA #$88     PRINT A BACKSPACE
      2930 COUT.1 JMP MON.COUT
      2940 RTS.1  RTS
      2950 *--------------------------------
      2960 FORWD  CPX LNGTH         ALREADY AT END OF LINE?
      2970        BCS RTS.1         ...YES
      2980        INX               ...NO, ADVANCE
      2990        LDA #$9C          PRINT $9C TO SPACE FORWARD
      3000        BIT COL.STATE     80- OR 40-COLUMNS?
      3010        BMI COUT.1        ...80-COLUMNS
      3020        JMP MON.ADVANCE   ...40-COLUMNS
      3030 *--------------------------------
      3040 DELCHR JSR BAKSPC       Delete char to left of cursor
      3050 DELCUR JSR MON.CLREOP    Delete char under cursor
      3060        LDA LNGTH
      3070        BEQ .2
      3080        PHX
      3090 .1     INX
      3100        CPX LNGTH
      3110        BCS .3
      3120        LDA INBUF,X       MOVE INBUF DOWN BY ONE
      3130        STA INBUF-1,X
      3140        JSR MON.COUT
      3150        BRA .1
      3160 .3     PLX               RESTORE CURSOR POSITION ON SCREEN
      3170        JSR CURSOR.POSN
      3180        DEC LNGTH
      3190 .2     RTS
      3200 *--------------------------------
      3210 DELBOL CPX LNGTH    If at eol, delete entire line
      3220        BCS DELALL
      3230        PHX               SAVE LOCAL POSITION WITHIN INBUF
      3240        JSR LINE.START    GO TO BEGINNING OF LINE
      3250        PLY               (Y) points at remaining chars
      3260 .1     LDA INBUF,Y       MOVE INBUF DOWN TO BEGINNING OF BUFFER
      3270        STA INBUF,X
      3280        JSR MON.COUT      AND WRITE TO SCREEN
      3290        INY
      3300        INX
      3310        CPY LNGTH
      3320        BCC .1
      3330        JSR DELEOL        LOP OFF THE REST
      3340 LINE.START
      3350        LDX #0             INDICATE BEGINNING OF INBUF
      3360        JMP CURSOR.POSN
      3370 *--------------------------------
      3380 DELALL JSR LINE.START    Delete entire line
      3390 DELEOL STX LNGTH         Delete from cursor to eol
      3400        JMP MON.CLREOP    CLEAR TO END OF WINDOW
      3410 *--------------------------------
      3420 INS.TOG
      3430        LDY CURSOR   SWAP THE CURSORS
      3440        LDA $E10134       CURRENT ACTIVE CURSOR
      3450        STA CURSOR        SAVE IT
      3460        TYA               PREVIOUS CURSOR
      3470        STA $E10134       START USING IT AGAIN
      3480        LDA INS.FLAG      TOGGLE THE FLAG
      3490        EOR #$80
      3500        STA INS.FLAG
      3510        RTS
      3520 *--------------------------------
      3530 *   Select stored input line from buffer
      3540 *      by scanning forward in time
      3550 *--------------------------------
      3560 DOWN   JSR PREPARE.BUFFER.SEARCH
      3570        BPL RTS.2    Buffer is empty
      3580        DEY
      3590 .1     INY          SEARCH FOR "00"
      3600        LDA BUFFER,Y
      3610        BNE .1
      3620 .2     INY          SEARCH FOR NON-ZERO
      3630        LDA BUFFER,Y
      3640        BEQ .2
      3650        JSR CBTB.1   STORE CHAR AND COPY REST OF CMND
      3660        STY WHERE
      3670        JMP CURSOR.POSN    RTN WITH CURSOR AT LINE END, CHK ADJUSTMENT
      3680 *--------------------------------
      3690 *   Select stored input line from buffer
      3700 *      by scanning backward in time.
      3710 *--------------------------------
      3720 UP     JSR PREPARE.BUFFER.SEARCH
      3730        BPL RTS.2    Buffer is empty
      3740        INY
      3750 .1     DEY          BACKUP TO NON-ZERO
      3760        LDA BUFFER,Y
      3770        BEQ .1
      3780 .2     DEY          BACKUP TO "00"
      3790        LDA BUFFER,Y
      3800        BNE .2
      3810        STY WHERE
      3820        JSR CBTB.2   COPY COMMAND TO INBUF
      3830        JMP CURSOR.POSN    RTN WITH CURSOR AT LINE END, CHK ADJUSTMENT
      3840 *--------------------------------
      3850 PREPARE.BUFFER.SEARCH
      3860        JSR LINE.START    GO TO BEGINNING OF LINE
      3870        JSR MON.CLREOP    CLEAR THE LINE
      3880        LDY WHERE         GET LAST POSITION IN BUFFER
      3890        BIT BUF.FLAG      ANYTHING IN BUFFER?
      3900 RTS.2  RTS
      3910 *--------------------------------
      3920 CBTB.1 STA INBUF,X
      3930        JSR MON.COUT
      3940        INX
      3950 CBTB.2 INY                COPY BUFFER TO INPUT BUFFER AND
      3960        LDA BUFFER,Y       DISPLAY ON SCREEN
      3970        BNE CBTB.1
      3980        STX LNGTH          SAVE TOTAL LINE LENGTH
      3990        RTS
      4000 *--------------------------------
      4010 TAB.FWD
      4020 .1     CPX LNGTH          ELSE, MOVE FORWARD IF NOT AT LINE END
      4030        BCS NEWPOS
      4040        INX
      4050        JSR COMPARE.TAB.CHARS
      4060        BCC .1             NO. GET THE NEXT INBUF CHAR
      4070 NEWPOS JMP CURSOR.POSN    YES. CALC NEW POSITION OF CURSOR
      4080 *--------------------------------
      4090 TAB.BAK
      4100 .1     TXA                TAB BACKWARD IF NOT AT LINE BEGINNING
      4110        BEQ NEWPOS
      4120        DEX
      4130        JSR COMPARE.TAB.CHARS
      4140        BCC .1
      4150        BCS NEWPOS
      4160 *--------------------------------
      4170 NORM.CHR
      4180        PLA          POP A RETURN ADDRESS
      4190        PLA
      4200        JSR DRCT.OFF
      4210        LDA CURRCHAR      GET INPUT CHAR
      4220        PHA                SAVE CHR FOR LATER CODE
      4230        CMP #$A0     IS IT A CONTROL CHAR?
      4240        BCS .2       ...NO
      4250        CMP #$8D     CARRIAGE RETURN?
      4260        BNE .0
      4270        JSR MOVE.TO.BUFFER
      4280        JSR END.OF.LINE
      4290 .0     BIT INS.FLAG       INSERTION MODE ON?
      4300        BPL .1             NO.
      4310        JSR INS.TOG        YES, TOGGLE INSERT MODE OFF
      4320 .1     STZ LNGTH          CLEAR TOTAL LINE LENGTH
      4330        PLA
      4340        CMP #$9B           ESC CHARACTER?
      4350        BNE .5
      4360 *---Handle ESC-------------------
      4370         STZ HOOK+1        SET CODE FOR PASS THRU WHILE IN 'ESC' MODE
      4380         JSR MON.ESC       LET MONITOR HANDLE ESCAPE MOVES
      4390         PHA               SAVE CHR ON THE STACK
      4400         JSR DRCT.OFF      RESET SET CODE TO CHK EACH CHR
      4410         ASL KEY.STATE     MOVE OPEN APPLE STATUS TO CARRY
      4420         BCS .4      AND RTN IF SET
      4430         LDA #" "          ELSE, INSERT A SPACE INTO INBUF
      4440         STA INBUF,X
      4450         INX               AND INCREMENT POSITION SO THAT NEXT TIME THRU
      4460 *                         KEY.EDIT WILL IGNORE THE LINE
      4470         BRA .4
      4480 .2     ASL KEY.STATE      MOVE STATUS OF OPEN APPLE KEY TO CARRY
      4490        BCS .4       IF SET, THEN RTN NOW
      4500        BIT INS.FLAG       INSERTION MODE ON?
      4510        BMI INS.CHR        YES. GO HANDLE IT
      4520        CPX LNGTH          NO. INC LENGTH IF AT END.
      4530        BCC .4
      4540        JSR CURSOR.POSN    POSITION CURSOR AT LINE END AND CHK
      4550 *                         ADJUSTMENT FOR BTM OF WINDOW
      4560        INC LNGTH
      4570 .4     PLA                GET CHAR FROM STACK AND RTN
      4580 .5     RTS
      4590 *--------------------------------
      4600 * This portion handles character insertions
      4610 * while the insert flag is on.
      4620 *--------------------------------
      4630 INS.CHR
      4640        PLY               GET CHR FROM STACK INTO Y-REG
      4650        PHY               LEAVE ON STACK TOO
      4660        PHX               SAVE LOCAL POSITION WITHIN INBUF
      4670        INC LNGTH         INCREASE LINE LENGTH BY ONE
      4680 .1     TYA               INSERT CHAR IN INBUF
      4690        LDY INBUF,X       GET CURRENT CHAR
      4700        STA INBUF,X       PUT NEW CHAR
      4710        JSR MON.COUT      AND DISPLAY ON SCREEN
      4720        INX               MOVE ON DOWN THE LINE
      4730        CPX LNGTH
      4740        BCC .1            MORE TO GO...
      4750        JSR CURSOR.POSN   ADJUSTMENT NEEDED FOR BEING NEAR WINDOW BTM?
      4760        PLX               RESET POSITION IN INBUF
      4770        JSR CURSOR.POSN   RESET CURSOR TO ITS ORIGINAL POSITION
      4780        PLA               INSERTED CHARACTER
      4790        RTS
      4800 *--------------------------------
      4810 END.OF.LINE
      4820        LDX LNGTH          CALCULATE OFFSET FROM LINE START
      4830 *--------------------------------
      4840 *   (X)=position in INBUF
      4850 *   Compute screen line and column for current position
      4860 *      and position cursor there.
      4870 *   If that is below window, adjust BOL accordingly and
      4880 *      position to bottom line.
      4890 *--------------------------------
      4900 CURSOR.POSN
      4910        LDY BOL      GET ROW OF LINE START
      4920        CLC          virtual screen position = BOC+X
      4930        TXA
      4940        ADC BOC
      4950 *---Adjust for window width------
      4960 .1     CMP WNDWDTH
      4970        BCC .2       THIS IS THE LINE
      4980        SBC WNDWDTH
      4990        INY          MOVE DOWN ONE LINE
      5000        BRA .1
      5010 *---HTAB to position-------------
      5020 .2     STA CH80
      5030        BIT COL.STATE     In 80-column mode?
      5040        BMI .3            ...yes
      5050        STA CH40          ...no, store in 40-col CH
      5060 *---Adjust if below window-------
      5070 .3     CPY WNDBTM
      5080        BCC .4       ON THE SCREEN NOW
      5090        DEC BOL      ADJUST BEGINNING OF LINE ROW NUMBER
      5100        DEY
      5110        BNE .3
      5120 *---VTAB to line-----------------
      5130 .4     STY CV
      5140        JMP MON.VTAB       SET NEW LINE ROW VALUE
      5150 *--------------------------------
      5160 DRCT.OFF
      5170        LDA #3
      5180        STA HOOK+1
      5190        RTS
      5200 *--------------------------------
      5210 CLEAR.BUFFER
      5220        LDY #0             ZERO CONTENTS OF STORAGE BUFFER
      5230        TYA
      5240 .1     STA BUFFER,Y
      5250        INY
      5260        BNE .1
      5270        STA BUF.FLAG       INDICATE NO BUFFER CONTENTS
      5280        RTS
      5290 *--------------------------------
      5300 MOVE.TO.BUFFER
      5310        LDA LNGTH         ANY CHARACTERS IN INBUF?
      5320        BEQ .3            ...NO, RETURN NOW
      5330        PHX                YES. SAVE POSITION WITHIN INBUF
      5340        LDY TOP            MOVE INBUF TO STORAGE BUFFER
      5350        LDX #0
      5360 .1     INY                POINT TO NEXT LOCATION IN BUFFER
      5370        LDA INBUF,X        MOVE INBUF AND PLACE ON TOP
      5380        STA BUFFER,Y
      5390        INX
      5400        CPX LNGTH
      5410        BCC .1
      5420        STA BUF.FLAG       TURN BUFFER FLAG ON
      5430        INY
      5440        STY TOP            MARK NEW POSITION OF TOP
      5450        STY WHERE          AND WHERE WE START AGAIN
      5460        TYX
      5470 .2     STZ BUFFER,X       ZERO OUT ANY RESIDUAL CMNDS
      5480        INX
      5490        LDA BUFFER,X
      5500        BNE .2
      5510        PLX
      5520 .3     RTS
      5530 *--------------------------------
      5540 TRUE.KEYIN
      5550        ASL COL.STATE     40- OR 80-COLUMNS?
      5560        ROR KYBRD         SAVE ANSWER IN KEYBOARD STORAGE BYTE
      5570        BMI .1       ...80
      5580        JMP KEYIN.40
      5590 .1     JMP KEYIN.80
      5600 *--------------------------------
      5610 COMPARE.TAB.CHARS
      5620        LDA INBUF,X       GET CURRENT CHAR FROM LINE
      5630        LDY #TAB.SZ-1     NUMBER OF TAB CHARACTERS
      5640 .1     CMP TAB.CHARS,Y
      5650        BEQ .2            IF THEY ARE THE SAME, RTN WITH CARRY SET
      5660        DEY               ELSE GO CHK THE NEXT CHAR
      5670        BPL .1            ...MORE IN LIST
      5680        CLC               NO TAB CHARACTERS MATCH SO CLEAR CARRY AND
      5690 .2     RTS                RETURN TO CALLER
      5700 *--------------------------------
      5710 TAB.CHARS    .AS -" ,.;:"
      5720 TAB.SZ .EQ *-TAB.CHARS
      5730 *--------------------------------
      5740 *   COMES HERE DURING PROCESSING OF "RESET"
      5750 *--------------------------------
      5760 RESET.PTCH
      5770        JSR DRCT.OFF
      5780        BIT KYBRD    WAS I IN 80-COLUMN?
      5790        BPL .1       ...NO
      5800        JSR COL80    ...YES
      5810 .1     STZ KSWL     HOOK MYSELF IN
      5820        LDA /HOOK
      5830        STA KSWH
      5840        JMP $3D0     FILLED IN BY INIT CODE
      5850 NORM.RESET .EQ *-2
      5860 *--------------------------------
      5870 KYBRD      .DA #0
      5880 BOC        .BS 1
      5890 BOL        .BS 1
      5900 LNGTH      .DA #0
      5910 INS.FLAG   .DA #0
      5920 BUF.FLAG   .DA #0
      5930 TOP        .DA #0
      5940 WHERE      .DA #0
      5950 CURSOR     .AS -/^/
      5960 CURRCHAR   .BS 1
      5970 *--------------------------------
      5980        .DO *>$9BFF
      5990 ...ERROR:  KEY.EDIT IS LONGER THAN 3 PAGES...
      6000        .ELSE
      6010 BUFFER     .EQ $9C00
      6020        .FIN
      6030 *--------------------------------
      6040        .EP

Apple Assembly Line (ISSN 0889-4302) is published monthly by S-C SOFTWARE CORPORATION, P. O. Box 280300, Dallas, TX 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 $14 postage for other countries. Back issues are $1.80 each for Volumes 1-7 (other countries inquire for postage). A subscription to the newsletter and the Monthly Disk containing all source code is $64 per year in the USA, Canada and Mexico, and $87 to other countries.

All material herein is copyrighted by S-C SOFTWARE, all rights reserved. Unless otherwise indicated, all material herein is authored by Bob Sander-Cederlof. (Apple is a registered trademark of Apple Computer, Inc.)