Joel's 6809 baby OS

Fork

00010 * The beginnings of a simple operating system for the
00011 * 6809 on the TRS-80 Color Computer
00012 * written in fulfillment of 
00013 * the Operating Systems part 2 class at BYU
00014 * in 1986 or thereabouts.
00015 * By Joel Matthew Rees, 
00016 * Copyright 2013 Joel Matthew Rees
00020 *
00021 * Offered under the GPL, v. 3.
00022 * See the LICENSE.TXT file for details on use and distribution.
00023 *
00030 * The source in its current form is this single file.
00031 * It was originally developed on a 
00032 * tape-and-cartridge development system,
00033 * Using Radio Shack's EDTAM+ cartridge.
00034 *
00080 	ORG $5000
00090 SYSGLO	EQU *
00100 * SYSGLO MUST BE ON EVEN PAGE (256 BYTE) BOUNDARY
00105 IVSAVE	RMB 2	IRQ VECTOR FOR RETURN TO EDTASM
00106 SVSAVE	RMB 2	SWI VECTOR FOR RETURN TO EDTASM
00110 HASTY	RMB 1	ABBREVIATE IRQ (TIMER) SERVICE?
00120 SLICEL	FCB 10	LIMIT OF TICKS/SLICE
00130 SLICE	RMB 1	COUNT OF TICKS REMAINING IN THIS SLICE
00140 BEEP	FCB 255 RMB 1	COUNT OF TICKS LEFT TO BEEP
00150 SYSERR	FDB 0
00160 CURPRO	FCB 0
00170 PROCIX	FDB 0	ADDRESS OF ENTRY IN PROTBL
00180 SPEED	FCB 0	COPY OF CURRENT PROCESS' PROCRT
00190 WINDIX	FCB 0	POINTER TO CURRENT WINDOW
00200 SYSATT	FCB 0	OPERATOR REQUEST FOR SYSTEM ATTENTION
00500 KEYOLD	RMB 8	KEYBOARD SCAN TABLES
00510 KEYSCN	RMB 8	OLD AND SCAN ARE NEGATIVE LOGIC
00520 KEYCHG	RMB 8	POSITIVE LOGIC FOR CHANGES IN LAST SLICE
00530 KEYOPN	RMB 8	POSITIVE LOGIC KEY RELEASE TABLE
00535 KEYLAS	FCB -1
00536 KEYRAW	FCB -1
00537 KEYVAL	FCB 0
00540 KEYTIM	FCB 0
00545 KEYRPT	FCB 40	REPEAT PAUSE
00546 KEYRAT	FCB 6	REPEAT PERIOD
00550 KEYIN	FDB KEYBUF
00560 KEYOUT	FDB KEYBUF
00600 YRBASE	FDB 1900
00610 YEAR	FCB 87
00620 MONTH	FCB 4
00630 DAY	FCB 1
00640 HOUR	FCB 0
00650 MINUTE	FCB 0
00660 SECOND	FCB 0
00670 TICK	FCB 0
00800 * 64 POTENTIAL LEAP YEARS IN BIT MAP (FASTER THAN DIVIDE)
00810 LYRTBL	FCB $FE	YEAR 1900
00820 	FCB $FF
00830 	FCB $FF
00840 	FCB $FF	YEAR 2000
00850 	FCB $FF
00860 	FCB $FF
00870 	FCB $FB	YEAR 2100
00880 	FCB $FF
00890 *
00900 * TABLE OF DAYS IN MONTHS
00910 MONTBL	FCB 0	NO DAYS IN MONTH ZERO
00920 	FCB 31
00930 	FCB 28
00940 	FCB 31
00950 	FCB 30
00960 	FCB 31
00970 	FCB 30
00980 	FCB 31	JULY
00990 	FCB 31	AUGUST
01000 	FCB 30
01010 	FCB 31
01020 	FCB 30
01030 	FCB 31
01040 	FCB 0	NO DAYS
01050 	FCB 0	IN MO.
01060 	FCB 0	13-15 (FOR AUTO-RESTORING)
01070 *
01080 * KEYBOARD SCAN CODES
01090 KEYTBL	FCB $60
01100 	FCC 'abcdefghijklmnopqrstuvwxyz'
01110 	FCB $13
01120 	FCB $0A
01130 	FCB 8
01140 	FCB 9
01150 	FCC ' 0123456789:;,-./'
01160 	FCB $0D
01170 	FCB KMT
01180 	FCB 3
01190 	FCB KMT
01200 	FCB KMT
01205 	FCB KMT
01210 	FCB KMT
01215 	FCB KMT
01220 KEYSHF	FCC /@ABCDEFGHIJKLMNOPQRSTUVWXYZ/
01230 	FCB $5E
01240 	FCB '[
01250 	FCB $5F
01260 	FCC /] \!"#$%&'()*+<=>?/
01270 	FCB $0C
01280 	FCB 1
01290 	FCB $7F
01291 	FCB KMT
01292 	FCB KMT
01293 	FCB KMT
01294 	FCB KMT
01295 	FCB KMT
01300 KEYCTL	FDB 1
01304 	FDB $203
01308 	FDB $405
01312 	FDB $607
01316 	FDB $809
01320 	FDB $0A0B
01324 	FDB $0C0D
01328 	FDB $0E0F
01332 	FDB $1011
01336 	FDB $1213
01340 	FDB $1415
01344 	FDB $1617
01348 	FDB $1819
01352 	FDB $1A1B
01356 	FDB $1C1D
01360 	FDB $1E1F
01364 	FDB $8081
01368 	FDB $8283
01372 	FDB $8485
01376 	FDB $8687
01380 	FDB $8889
01384 	FDB $7C8B
01388 	FDB $7B7E
01392 	FDB $7D8F
01396 	FCB $8A
01400 	FCB KMT
01404 	FCB KBREAK
01408 	FCB KMT
01412 	FCB KMT
01416 	FCB KMT
01420 	FCB KMT
01424 	FCB 1
01428 *
01450 KEYBUF	RMB 129
01460 KEYEND	FDB 0	SAFETY
01500 NUMPRO	EQU 16
01505 PROTBL	EQU *	P0 IS IDLE PROCESS
01510 PROCSP	EQU *-PROTBL	SYSTEM STACK POINTER IN SUSPENSE
01520 	FDB IDLESP
01530 PROCSB	EQU *-PROTBL	SYSTEM STACK BASE
01540 	FDB IDLESP
01542 PROCSL	EQU *-PROTBL	SYSTEM STACK LIMIT
01544 	FDB IDLESL
01550 PROCUB	EQU *-PROTBL	USER STACK BASE
01560 	FDB IDLEUB
01562 PROCUL	EQU *-PROTBL	USER (PARAMETER) STACK LIMIT
01564 	FDB IDLEUL
01570 PROCBA	EQU *-PROTBL	BOTTOM OF PROCESS IMAGE
01580 	FDB O	START UP
01590 PROCLI	EQU *-PROTBL	TOP OF PROCESS IMAGE
01600 	FDB IDLLIM
01940 PROCST	EQU *-PROTBL	PROCESS STATE
01950 	FCB 0
01960 PROCRT	EQU *-PROTBL	OVERDRIVE (2X) CLOCK RATE FLAG
01970 	FCB 0
01980 PROSIZ	EQU *-PROTBL	SIZE OF PROCESS TABLE
01990 	RMB (NUMPRO-1)*PROSIZ
02000 *
02010 CARRY	EQU 1	FLAG BIT
02020 TIMOVR	EQU $8000
02030 IRQMSK	EQU $10
02040 KEYROW	EQU $FF00
02050 KEYCOL	EQU $FF02
02060 IRQVEC	EQU $10D
02065 SWIVEC	EQU $107
02070 VIDMOD	EQU $FF22
02080 BSOUND	EQU 2
02090 OVRDRV	EQU $FFD9
02100 KBREAK	EQU $E0
02110 KMT	EQU $F0
02120 SCRWID	EQU 32
02130 VSPACE	EQU $60	MC6847
02140 UNDEF	EQU -1
02500 NUMWIN	EQU 8
02502 WINTBL	EQU *
02504 WSCR	EQU *-WINTBL
02506 	FCB 2 CONSOLE
02510 WLCOL	EQU *-WINTBL
02520 	FCB 0
02530 WWCOL	EQU *-WINTBL
02540 	FCB 12
02550 WTROW	EQU *-WINTBL
02560 	FCB 0
02570 WLROW	EQU *-WINTBL
02580 	FCB 5
02590 WCURCL	EQU *-WINTBL
02600 	FCB 0
02610 WCURRW	EQU *-WINTBL
02620 	FCB 0
02630 WCSCLR	EQU *-WINTBL
02640 	FCB $8F
02650 WCSTIM	EQU *-WINTBL
02660 	FCB 0
02670 WCSTAT	EQU *-WINTBL	B7=DISPLAY	B6-B0=COUNT
02680 	FCB $8F
02700 WINSIZ	EQU *-WINTBL
02709 * CLOCK WINDOW
02710 	FCB 2
02711 	FCB 13
02712 	FCB 18
02713 	FCB 0
02714 	FCB 0
02715 	FCB 0
02716 	FCB 0
02717 	FCB $8F
02718 	FCB 0
02719 	FCB 0
02720 *
02721 * TEST WINDOW
02722 	FCB 2
02723 	FCB 0
02724 	FCB 31
02725 	FCB 6
02726 	FCB 9
02727 	FCB 0
02728 	FCB 0
02729 	FCB $8F
02730 	FCB 0
02731 	FCB $83
02732 *
02890 	RMB (NUMWIN-2)*WINSIZ
02900 KSTACO	FDB 0
02910 	RMB $100	KERNEL'S STACK
02920 KSTACK	EQU *
02930 KUSTKO	FDB 0
02940 	RMB $100	KERNEL'S PARAMETER STACK
02950 KUSTAK	EQU *
02960 	FDB 0
03000 *
03010 * SYSGLO CONTAINS SYSTEM GLOBALS
03020 IRQSRV	INC TICK,PCR
03030 	TST HASTY,PCR
03040 	BEQ *+3
03050 	RTI
03060 *
03065 *	CLR OVRDRV	SWITCH TO WARP SPEED
03070 * INDEX PROCESS TABLE ENTRY
03072 	LEAX PROTBL,PCR
03074 	LDA #PROSIZ
03076 	LDB CURPRO
03078 	MUL
03080 	LEAX D,X
03082 	STX PROCIX
03084 	STS PROCSP,X
03090 * SWITCH TO KERNEL STACK
03095 	LDU #KUSTAK
03100 	LDS #KSTACK
03110 * DEFINITELY NOT RE-ENTRANT
03120 	LEAY SYSGLO,PCR
03130 	TFR Y,D
03140 	TFR A,DP
03150 	SETDP  SYSGLO/$100
03155 * HALF OF 60 HZ BEL
03160 	TST BEEP
03170 	BEQ *+5
03200 	LBSR CLICK
03205 *
03210 	LDA TICK
03211 	SUBA #60
03212 	LBLO KEYRD
03213 	INC SECOND
03214 	STA TICK	ALLOW TICKS TO OVERFLOW
03215 	LDA SECOND
03220 	SUBA #60
03230 	LBLO KEYRD
03240 	INC MINUTE
03250 	STA SECOND	ALLOW SECONDS TO OVERFLOW
03260 	LDA MINUTE
03270 	SUBA #60
03280 	LBLO KEYRD
03290 	INC HOUR
03300 	CLR MINUTE
03310 	LDA HOUR
03320 	SUBA #24
03330 	BLO KEYRD
03340 	INC DAY
03350 	CLR HOUR
03360 *
03370 	LDA MONTH
03380 	ANDA #$F	CRUDE AUTO-RESTORE
03390 * CHECK LEAP YEAR
03400 	CMPA #2
03410 	BNE NOLEAP
03420 	LDB YEAR
03430 	BITB #3 	MODULO 4
03440 	BNE NOLEAP
03450 	LSRB	YEAR/4
03460 	LSRB
03470 	PSHS B
03480 	LSRB	YEAR/32
03490 	LSRB
03500 	LSRB
03510 	LEAX LYRTBL,PCR
03520 	LEAX B,X
03530 	PULS A	BIT #
03540 	ANDA #7
03550 	CLRB
03560 	ORCC #CARRY
03570 LYRBLP	ROLB
03580 	DECA
03590 	BPL LYRBLP
03600 *
03610 	ANDB ,X	LEAP?
03620 	BEQ NOLEAP
03630 	LEAX MONTBL,PCR
03640 	LDB 2,X
03650 	INCB	ONE MORE DAY
03660 	CMPB DAY
03670 	BHS KEYRD
03680 	INC MONTH
03690 	LDB #1
03700 	STB DAY
03710 	BRA KEYRD	NOW MARCH, SAME YEAR
03720 *
03730 NOLEAP	LDD MONTH
03740 	ANDA #$F
03750 	LEAX MONTBL,PCR
03760 	CMPB A,X	CHECK DAYS FOR THIS MONTH
03770 	BLS KEYRD
03780 	LDB #1
03790 	STB DAY
03800 	INCA
03810 	CMPA #12
03820 	BHI *+6
03830 	STA MONTH
03840 	BRA KEYRD
03850 	STB MONTH
03860 	INC YEAR
03870 	BNE KEYRD
03880 	LDD #TIMOVR
03890 	STD SYSERR
03900 *
03910 KEYRD	INC KEYTIM
03915 	LDA KEYROW+1	CONTROL/STATUS REGISTER
03920 	ANDA #.NOT.4	SELECT DATA DIRECTION REGISTER
03930 	STA KEYROW+1
03940 	CLRB	0-7 INPUT
03950 	STB KEYROW
03960 	ORA #4	SELECT DATA REGISTER
03970 	STA KEYROW+1
03980 	LDA KEYCOL+1
03990 	ANDA #.NOT.4
04000 	STA KEYCOL+1
04010 	COMB	ALL OUT
04020 	STB KEYCOL
04030 	ORA #4
04040 	STA KEYCOL+1
04050 	STB KEYCOL
04060 	LEAY KEYSCN,PCR
04070 	LDX #8	LIMIT SCAN LOOP
04080 	ANDCC #.NOT.CARRY
04090 KYSCAN	ROL KEYCOL	TO LS BIT
04100 	LDA KEYROW
04110 	ORA #$80	MASK JOYSTICK COMP BIT
04120 	TFR A,B
04130 	COMA	POSITIVE LOGIC
04140 	ANDA ,Y	NEW BIT AND NOT OLD BIT?
04150 	STA KEYCHG-KEYSCN,Y	SAVE NEWLY SET BITS
04151 	TFR B,A
04152 	COMA	NOT (NEW OR NOT OLD)
04153 	ORA ,Y
04154 	COMA
04155 	STA KEYOPN-KEYSCN,Y
04160 	STB ,Y+	SAVE NEW STATE
04170 	LEAX -1,X
04180 	ORCC #CARRY	FOR SCAN
04190 	BNE KYSCAN	COUNTED OUT?
04200 *
04210 * SCAN FOR PHANTOMS
04220 	LEAY KEYOLD,PCR
04230 	LDB #7	COLUMN COUNT TO SCAN
04240 KYSCNS	LDA KEYSCN-KEYOLD,Y	GET SCANNED KEYS
04250 	COMA	+ LOGIC
04260 	BEQ KYNSCN
04270 	LSRA
04280 	BCC *-1	FIND A KEY
04290 	BEQ KYNSCN	MORE THAN ONE KEY?
04300 	LEAX KEYSCN-KEYOLD,Y	SCAN FOR DUPLICATED BITS
04310 	PSHS B
04320 	LDA ,X+	SCAN CODE (AGAIN)
04330 KYPHML	CMPA ,X+	DUPLICATED?
04340 	BNE KYNPHM
04350 	CLR KEYCHG-KEYSCN-1,X	NO CHANGES SEEN
04360 	LDA KEYOLD-KEYSCN-1,X	HOLDOVER SCAN
04370 	STA -1,X
04380 	CLR KEYCHG-KEYOLD,Y	UNDO BOTH
04390 KYNPHM	DECB
04400 	BNE KYPHML
04410 	PULS B	RESTORE COUNT
04420 	TST KEYCHG-KEYOLD,Y	BITS CLEARED?
04430 	BNE KYNSCN
04440 	LDA ,Y+	CLEAR MATCHED BITS, ALSO
04450 	STA KEYSCN-KEYOLD-1,Y
04460 	BRA KYYSCN
04470 KYNSCN	LDA KEYSCN-KEYOLD,Y	UPDATE OLD STATE
04480 	STA ,Y+
04490 KYYSCN	DECB	NEXT COL
04500 	BNE KYSCNS
04510 *
04520 * TRANSLATE KEYS
04530 	LEAY KEYSCN,PCR
04540 	LDA #$40	ROW 6
04550 	BITA 1,Y
04560 	BEQ KYCTRL	NEGATIVE LOGIC
04570 	BITA 7,Y
04580 	BEQ KYSHFT
04590 	LEAX KEYTBL,PCR	UNSHIFTED KEYS
04600 	BRA KYTRAN
04610 KYCTRL	LEAX KEYCTL,PCR
04620 	BRA KYTRAN
04630 KYSHFT	LEAX KEYSHF,PCR
04640 KYTRAN	LDB #7	MAX COL
04650 KYTRLP	LEAY KEYCHG,PCR
04660 	LDA B,Y	CLOSURE BITS
04670 	BEQ KYTRUP
04680 	PSHU A,B
04690 	LDB #-1	ROW COUNT
04700 KYTRDL	BSR KYTBIT
04710 	CMPA #KMT	DEFINED?
04720 	BEQ KYTRDM
04730 	PSHU A
04740 	BSR KYBPUT
04750 KYTRDM	TST ,U	MORE ROWS?
04760 	BNE KYTRDL
04770 	PULU A,B
04780 KYTRUP	LEAY KEYOPN,PCR
04790 	LDA B,Y
04795 	BEQ KYTRNX
04800 	PSHU A,B
04810 	LDB #-1
04820 KYTRUL	BSR KYTBIT
04825 	LDA KEYLAS
04830 	CMPA KEYLAS
04840 	BNE KYTRUM
04850 	CLR KEYTIM
04860 	LDA #-1
04870 	STA KEYLAS
04880 KYTRUM	TST ,U
04890 	BNE KYTRUL
04900 	PULU A,B
04910 KYTRNX	DECB
04920 	BPL KYTRLP
04930 *
04940 * REPEATS
04950 	LDA KEYLAS
04960 	CMPA #-1
04970 	BEQ KYRPNO
04980 	LDB KEYTIM
04990 	CMPB KEYRPT
05000 	BLO KYRPNO
05004 	LDA KEYVAL
05005 	PSHU A
05006 	BSR KYBPUT
05010 	SUBB KEYRAT
05020 	STB KEYTIM
05050 KYRPNO	BRA DOBEEP
05060 *
05065 * WILL HANG IF TOP OF STACK CLEAR
05070 KYTBIT	LDA ,U	ROW BITS
05080 KYTBLP	INCB	COUNT BIT
05090 	LSRA
05100 	BCC KYTBLP
05110 	STA ,U
05120 	TFR B,A	KEEP COUNT
05130 	ASLA
05140 	ASLA
05150 	ASLA
05160 	ADDA 1,U	COLUMNS
05165 	STA KEYRAW
05170 	LDA A,X	CHARACTER
05175 	STA KEYVAL
05180 	RTS
05190 *
05200 *BUFFER READ MUST ALSO BE UNINTERRUPTIBLE (SINGLE MPU)
05210 KYBPUT	PSHS A,X,CC
05220 	ORCC #IRQMSK
05230 	PULU A	KEY CODE
05240 	CMPA #KBREAK	SYSTEM ATTENTION?
05250 	BNE KYBPCH
05260 	STA SYSATT
05270 	LDA #-1
05280 	BRA KYBPF1	NO REPEAT
05290 KYBPCH	CMPA #KMT
05300 	BEQ KYBPF
05310 	LEAX KEYEND,PCR
05320 	PSHS X	WRAP TEST
05330 	LDX KEYIN
05340 	STA ,X+
05350 	CMPX ,S++
05360 	BLO KYBPNW
05370 	LEAX KEYBUF,PCR
05380 KYBPNW	CMPX KEYOUT
05390 	BNE KYBPNF
05400 	LDA #12
05410 	ADDA BEEP
05420 	STA BEEP
05430 	LDA #-1
05440 	BRA KYBPF1
05450 KYBPNF	STX KEYIN
05455 	LDA KEYRAW
05460 KYBPF1	STA KEYLAS
05470 KYBPF	CLR KEYTIM
05480 	PULS A,X,CC,PC
05490 *
10000 *
10003 * OTHER HALF OF 60 HZ BEL
10005 DOBEEP	LDA BEEP
10007 	BEQ NOBEEP
10009 	DECA
10011 	STA BEEP
10013 	LBSR CLICK
10015 NOBEEP	LDX PROCIX
10025 	TST PROCRT,X
10027 	BNE *+5
10040 	CLR OVRDRV-1	BACK TO VISIBLE SPEED
10050 	LDS PROCSP,X
10060 	RTI
10062 	SETDP 0
10070 *
15000 * Z IS UNDEFINED HANDLER
15005 CALTBL	FDB YIELD
15630 	FDB Z
15640 CALSIZ	EQU (*-CALTBL)/2-1
15650 	SETDP  SYSGLO/$100
15660 Z	STA $5FF
15670 	LDA #UNDEF
15680 	STA SYSERR
15800 YIELD	CWAI #.NOT.IRQMSK
15810 	RTS
16000 * SWI DISABLES IRQ
16010 SWISRV	LEAY CALTBL,PCR
16020 	LEAX SYSGLO,PCR
16030 	TFR X,D
16040 	TFR A,DP
16045 	SETDP  SYSGLO/$100
16050 * INDEX PROCESS TABLE ENTRY
16060 	LEAX PROTBL,PCR
16070 	LDA #PROSIZ
16080 	LDB CURPRO
16090 	MUL
16100 	LEAX D,X
16110 	STX PROCIX
16120 	PULU A	CALL #
16130 	CMPA #CALSIZ
16140 	BLS SWISC
16150 	JSR [CALSIZ*2,Y]	UNDEFINED
16160 	BRA SWISN
16180 SWISC	ASLA	WORD
16190 	JSR [A,Y]	SIGNED OFFSET
16195 SWISN	STU 8,S	BALANCE PARAMETERS
16200 	RTI
20000 *
20010 CLICK	PSHS A
20020 	LDA VIDMOD
20030 	EORA #BSOUND
20040 	STA VIDMOD
20050 	PULS A,PC
20060 *
20070 GETKEY	PSHS CC,A,B,X,Y
20080 	LEAY KEYEND,PCR
20090 	PSHS Y
20095 	BSR IXWIND
20100 	LDY ,U
20120 	BSR IXCRSR
20125 	LDA WCSCLR,Y
20130 	LDB [,U]	CHARACTER UNDER CURSOR
20140 	ORCC #IRQMSK
20150 GETKLP	LDX KEYOUT
20160 	CMPX KEYIN
20170 	BNE GETKIN
20180 	PSHS B
20190 	LDB WCSTAT,Y	DISPLAY IT?
20200 	BPL GETKNC
20210 	ANDB #$7F	FLASH?
20220 	BEQ GETKNF
20230 	DEC WCSTIM,Y
20240 	BGT GETKNF
20250 	STB WCSTIM,Y	RESTORE COUNT
20260 	ADDA #$10	NEW COLOR
20270 	BMI GETKNF
20280 	LDA #$8F
20290 GETKNF	STA [,U]	CURSOR ON SCREEN
20300 GETKNC	PULS B
20310 	CLR ,-U	YIELD CPU
20320 	SWI
20330 	BRA GETKLP
20340 GETKIN	STB [,U++]	PUT CHARACTER BACK ON SCREEN
20350 	LDA ,X+
20360 	CMPX ,S++	WRAP?
20370 	BLO GETKBF
20380 	LEAX KEYBUF,PCR
20390 GETKBF	STX KEYOUT
20400 	PSHU A
20410 	PULS PC,CC,A,B,X,Y
20420 *
20430 IXWIND	PSHS A,B,Y
20440 	LEAY WINTBL,PCR
20450 	PULU B
20460 	ANDB #NUMWIN-1
20470 	LDA #WINSIZ
20480 	MUL
20490 	LEAY D,Y
20500 	PSHU Y
20510 	PULS A,B,Y,PC
20520 *
20530 IXCRSR	PSHS A,B,X
20540 	LDX ,U
20545 	PSHU X
20546 	BSR BWIND
20550 	LDA WSCR,X
20560 	ASLA
20570 	PSHS A
20580 	LDA #SCRWID
20590 	LDB WCURRW,X
20600 	ADDB WTROW,X
20610 	MUL
20620 	ADDB WLCOL,X
20630 	ADCA #0
20640 	ADDB WCURCL,X
20650 	ADCA ,S+
20660 	STD ,U
20670 	PULS A,B,X,PC
20680 *
20690 VITRAN	PSHS A
20700 	LDA ,U
20710 	CMPA #'  '
20720 	BLO VITRDF
20730 	CMPA #'?
20740 	BHI *+6
20750 	ORA #$40	UNINVERT
20760 	BRA VITRET
20770 	CMPA #'^
20780 	BLS VITRET	PASS IT ON
20790 	CMPA #$60	GRAVE ACCENT
20800 	BHS *+6
20810 	LDA #$20	UNDERSCORE IS INVERTED SPACE
20820 	BRA VITRET
20830 	BHI *+6
20840 	LDA #$27	INVERTED ACCENT
20850 	BRA VITRET
20860 	CMPA #$7C	BAR
20870 	BNE *+6
20880 	LDA #$3A	INVERTED COLON
20890 	BRA VITRET
20900 	CMPA #$7F	DELETE
20910 	BHS VITRDF
20920 	ANDA #$1F	LOWER CASE IS INVERTED CAP ALPHA
20930 VITRET	STA ,U
20940 	PULS A,PC
20950 VITRDF	LDA #$3F	INVERTED ? FOR BAD CODES
20960 	BRA VITRET
20970 *
20980 * RESTORE CURSOR TO WINDOW BOUNDARIES
20990 BWIND	PSHS A,Y
21000 	PULU Y
21010 	LDA WCURRW,Y
21020 	BPL BWINRH
21030 	CLR WCURRW,Y
21040 	CLR WCURCL,Y
21050 	BRA BWINQT
21060 BWINRH	CMPA WLROW,Y
21070 	BLS BWINCL
21080 	LDA WLROW,Y
21090 	STA WCURRW,Y
21100 	LDA WWCOL,Y
21110 	STA WCURCL,Y
21120 	BRA BWINQT
21130 BWINCL	LDA WCURCL,Y
21140 	BPL BWINCH
21150 	CLR WCURCL,Y
21160 	BRA BWINQT
21170 BWINCH	CMPA WWCOL,Y
21180 	BLS BWINQT
21190 	LDA WWCOL,Y
21200 	STA WCURCL,Y
21210 BWINQT	PULS A,Y,PC
21220 *
21230 * RETURN POINTER TO HOME IN WINDOW
21240 IXHOME	PSHS A,B,X
21250 	LDX ,U
21260 	LDA WSCR,X
21270 	ASLA
21280 	PSHS A
21290 	LDA #SCRWID
21300 	LDB WTROW,X
21310 	MUL
21320 	ADDB WLCOL,X
21330 	ADCA ,S+
21340 	STD ,U
21350 	PULS A,B,X,PC
21360 *
21370 * SPLIT SCREEN AND INSERT LINE AT CURSOR
21380 USPLIT	PSHS A,B,X,Y
21390 	LDY ,U	SET UP
21400 	BSR IXHOME
21410 	PULU X
21420 	LDA WCURRW,Y
21430 	BPL *+4
21440 	PULS A,B,X,Y,PC	EARLY RETURN
21450 	LDB #SCRWID-1
21460 	SUBB WWCOL,Y	WRAP ADJUST
21470 	PSHS A,B
21480 	LDB WCURCL,Y
21490 	CMPB WWCOL,Y
21500 	BLS USPLCF
21510 	CLR WCURCL,Y
21520 	INCA	WRAP ROW
21530 USPLCF	TSTA	ROW 0?
21540 	BNE USPLRT
21550 	LDA #VSPACE
21560 	LDB WCURCL,Y
21570 	BEQ USPLQT
21580 USPLL0	STA ,X+
21590 	DECB	TO CURSOR
21600 	BGT USPLL0
21610 	BRA USPLQT
21620 * DO WHOLE ROWS
21630 USPLRT	CMPA WLROW,Y
21640 	BLS USPLSR
21650 	LDA WLROW,Y
21660 	INCA	OVER END
21670 	STA WCURRW,Y
21680 USPLSR	DECA	# SCROLL
21690 	BEQ USPLPS
21700 	STA ,S
21710 USPLRL	LDB WWCOL,Y
21720 USPLCL	LDA SCRWID,X
21730 	STA ,X+
21740 	DECB	NATURAL
21750 	BPL USPLCL
21760 	LDB 1,S
21770 	ABX	WRAP LINE
21780 	DEC ,S	WHOLE CT
21790 	BGT USPLRL
21800 * NOW PARTIAL SCROLL LAST
21805 USPLPS	LDB #VSPACE
21810 	LDA WCURCL,Y
21820 	BEQ USPLCE
21830 	STA ,S
21850 USPLPL	LDA SCRWID,X
21860 	STB SCRWID,X
21870 	STA ,X+
21880 	DEC ,S	WHOLE CT
21890 	BGT USPLPL
21900 USPLCE	DEC WCURRW,Y	BUMP CURSOR BACK
21910 	LDA WWCOL,Y
21920 	SUBA WCURCL,Y
21930 USPLEL	STB ,X+
21940 	DECA	NATURAL
21950 	BPL USPLEL
21960 USPLQT	LEAS 2,S
21970 	PULS A,B,X,Y,PC
21980 *
21990 * PUT CHARACTER ON SCREEN, TTY, WITH CONTROL CHARACTERS
22000 VPUTCH	PSHS A,X
22010 	PULU A
22020 	LBSR IXWIND
22030 	CMPA #$20
22040 	BHS VPUTVC
22050 	ASLA	CTL FN
22060 	LEAX CTLTBL,PCR
22070 	JSR [A,X]
22080 	BRA VPUTQT
22090 * PUT VISIBLE CHARACTER
22100 VPUTVC	PSHU A
22110 	LBSR VITRAN
22120 	PULU A
22130 	LDX ,U
22140 	LBSR IXCRSR
22150 	STA [,U++]
22160 	INC WCURCL,X
22170 	LDA WCURCL,X
22180 	CMPA WWCOL,X
22190 	BLS VPUTQT
22210 	CLR WCURCL,X
22220 	INC WCURRW,X
22230 	LDA WCURRW,X
22240 	CMPA WLROW,X
22250 	BLS VPUTQT
22260 	PSHU X
22270 	LBSR USPLIT
22280 VPUTQT	PULS A,X,PC
22290 *
22300 * TABLE OF CONTROL FUNCTION POINTERS FOR PRINT ROUTINES
22310 CTLTBL	FDB VNUL	ASCII NUL
22320 	FDB VNUL
22330 	FDB VNUL
22340 	FDB VNUL
22350 	FDB VNUL
22360 	FDB VNUL
22370 	FDB VNUL
22380 	FDB VBEL
22390 	FDB VBS
22400 	FDB VNUL
22410 	FDB VNUL
22420 	FDB VNUL
22430 	FDB VFF
22440 	FDB VCR
22450 	FDB VNUL
22460 	FDB VNUL
22470 	FDB VNUL
22480 	FDB VNUL
22490 	FDB VNUL
22500 	FDB VNUL
22510 	FDB VNUL
22520 	FDB VNUL
22530 	FDB VNUL
22540 	FDB VNUL
22550 	FDB VNUL
22560 	FDB VNUL
22570 	FDB VNUL
22580 	FDB VNUL
22590 	FDB VNUL
22600 	FDB VNUL
22610 	FDB VNUL
22620 	FDB VNUL
22630 *
22640 * DO NOTHING
22650 VNUL	LEAU 2,U
22660 	RTS
22670 *
22680 * LOW TONE
22690 VBEL	PSHS A
22700 	LEAU 2,U
22710 	LDA BEEP
22720 	ADDA #30
22730 	STA BEEP
22740 	PULS A,PC
22750 *
22760 * BACK SPACE DESTRUCTIVE
22770 VBS	PSHS A,X
22780 	LDX ,U
22790 	DEC WCURCL,X
22800 	BPL VBSNW
22810 	LDA WWCOL,X
22820 	STA WCURCL,X
22830 	DEC WCURRW,X
22840 	BPL VBSNW
22850 	CLR WCURRW,X
22855 	CLR WCURCL,X
22860 VBSNW	LBSR IXCRSR
22870 	LDA #VSPACE
22880 	STA [,U++]
22890 	PULS A,X,PC
22900 *
22910 * CLEAR WINDOW, HOME CURSOR
22920 VFF	PSHS A,B,X,Y
22930 	LDY ,U
22940 	LBSR IXHOME
22950 	PULU X
22960 	CLR WCURRW,Y
22970 	CLR WCURCL,Y
22980 	LDB #SCRWID-1
22990 	SUBB WWCOL,Y
23000 	LDA WLROW,Y
23010 	PSHS A,B
23020 	LDA #VSPACE
23030 VFFLL	LDB WWCOL,Y
23040 VFFCL	STA ,X+
23050 	DECB
23060 	BPL VFFCL
23070 	LDB 1,S
23080 	ABX
23090 	DEC ,S
23100 	BPL VFFLL
23110 	LEAS 2,S
23120 	PULS A,B,X,Y,PC
23130 *
23140 * CLEAR TO END, FEED/HOME
23150 VCR	PSHS A,B,X,Y
23160 	LDY ,U
23170 	LBSR IXCRSR
23180 	PULU X
23190 	LDA #VSPACE
23200 	LDB WWCOL,Y
23210 	SUBB WCURCL,Y
23220 	BLO VCRDUN
23230 VCRLUP	STA ,X+
23240 	DECB
23250 	BPL VCRLUP
23260 	CLR WCURCL,Y
23270 	INC WCURRW,Y
23280 	LDA WCURRW,Y
23290 	CMPA WLROW,Y
23300 	BLS VCRDUN
23310 	PSHU Y
23320 	LBSR USPLIT
23330 VCRDUN	PULS A,B,X,Y,PC
23340 *
50000 O	EQU *
50010 * STARTUP CODE
50020 * INTIALIZE PORTS
50030 * 1 BIT SOUND OUTPUT
50032 	LDS #IDLESP
50034 	LDU #IDLEUB
50040 	LDA VIDMOD+1
50050 	ANDA #.NOT.4
50060 	STA VIDMOD+1	DATA DIRECTION REGISTER
50070 	LDB VIDMOD
50080 	ORB #BSOUND
50090 	STB VIDMOD
50100 	ORA #4	DATA REGISTER
50110 	STA VIDMOD+1
50120 * ENABLE IRQ ON FIELD SYNC
50130 * (INTERRUPTS 60 TIMES A SECOND
50140 * MASK IRQ FIRST
50150 	ORCC #IRQMSK
50160 * SET UP IRQ VECTOR
50170 	LDD IRQVEC
50180 	STD IVSAVE,PCR
50190 	LDD #IRQSRV
50200 	STD IRQVEC
50205 * ENABLE PORT
50210 	LDA KEYCOL+1
50220 	ORA #1
50230 	STA KEYCOL+1
50240 * HANDSHAKE BY READING KEYCOL (IMPLICIT IN KEY DECODE)
50250 	LDD SWIVEC	SET UP SYSTEM CALLS - SWI
50260 	STD SVSAVE,PCR
50270 	LDD #SWISRV
50280 	STD SWIVEC
50330 *
50340 	LEAY SYSGLO,PCR
50350 	TFR Y,D
50360 	TFR A,DP
50370 	SETDP SYSGLO/256
50390 WAITIQ	CLR ,-U	WINDOW 0
50410 	LBSR GETKEY
50411 	PULU A
50412 	CMPA #3
50413 	BEQ IQDONE
50420 	CLRB
50430 	PSHU  A,B
50440 	LBSR VPUTCH
50480 	BRA WAITIQ
50485 IQDONE	ORCC #IRQMSK
50490 	LDA KEYCOL+1
50500 	ANDA #.NOT.1
50510 	STA KEYCOL+1
50520 	LDD SVSAVE,PCR
50530 	STD SWIVEC
50540 	LDD IVSAVE,PCR
50550 	STD IRQVEC
50560 	SWI
55990 *
56000 	FDB 0
56010 IDLESL	RMB 128
56020 IDLESP	EQU *
56030 	FDB 0
56032 IDLEUL	RMB 128
56034 IDLEUB	EQU *
56036 	FDB 0
56040 IDLLIM	EQU *
56050 *
62000 	END