In This Issue...
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.
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 |
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 *-------------------------------- |
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 *-------------------------------- |
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 |
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.)