* fig-FORTH FOR 6809, converted by unintelligent conversion from 6800 source.
* To do:
-* 3 IO routines
+* 4 IO routines
* adjust ram locations
* then add trace routines
* then try in emulator
* PEMIT ( word # 182 )
* PKEY ( 183 )
* PQTERM ( 184 )
+* Note: PCR, also. (PRTCR)
*
* The FORTH words for disc related I/O follow the model
* of the FORTH Interest Group, but have not been
* called by words 13 through 16 in the dictionary.
*
* ======>> 182 << code for EMIT
-PEMIT STB N save B
- STX N+1 save X
- LDB ACIAC
- BITB #2 check ready bit
- BEQ PEMIT+4 if not ready for more data
- STA ACIAD
- LDX UP
- STB IOSTAT-UORIG,X
- LDB N recover B & X
- LDX N+1
- RTS only A register may change
+* character to output in A
+* Coco:
+PEMIT PSHS Y,U,DP
+ CLRB
+ TFR B,DP
+ JSR [$A002]
+ PULS Y,U,DP,PC
+*
+* PEMIT STB N save B
+* STX N+1 save X
+* LDB ACIAC
+* BITB #2 check ready bit
+* BEQ PEMIT+4 if not ready for more data
+* STA ACIAD
+* LDX UP
+* STB IOSTAT-UORIG,X
+* LDB N recover B & X
+* LDX N+1
+* RTS only A register may change
* PEMIT JMP $E1D1 for MIKBUG
* PEMIT FCB $3F,$11,$39 for PROTO
* PEMIT JMP $D286 for Smoke Signal DOS
*
* ======>> 183 << code for KEY
-PKEY STB N
- STX N+1
- LDB ACIAC
- ASRB
- BCC PKEY+4 no incoming data yet
- LDA ACIAD
- ANDA #$7F strip parity bit
- LDX UP
- STB IOSTAT+1-UORIG,X
- LDB N
- LDX N+1
- RTS
+* Returns input character in A
+* Coco:
+PKEY PSHS Y,U,DP
+ CLRB
+ TFR B,DP
+ LDA #$CF a cursor
+ LDB [$0088] (locate) save
+ STA [$0088]
+PKEYBZ JSR [$A000]
+ BEQ PKEYBZ
+ STB [$0088] restore
+ PULS Y,U,DP,PC
+*
+* PKEY STB N
+* STX N+1
+* LDB ACIAC
+* ASRB
+* BCC PKEY+4 no incoming data yet
+* LDA ACIAD
+* ANDA #$7F strip parity bit
+* LDX UP
+* STB IOSTAT+1-UORIG,X
+* LDB N
+* LDX N+1
+* RTS
* PKEY JMP $E1AC for MIKBUG
* PKEY FCB $3F,$14,$39 for PROTO
* PKEY JMP $D289 for Smoke Signal DOS
*
* ######>> screen 64 <<
* ======>> 184 << code for ?TERMINAL
-PQTER LDA ACIAC Test for 'break' condition
- ANDA #$11 mask framing error bit and
-* input buffer full
- BEQ PQTER2
- LDA ACIAD clear input buffer
- LDA #01
-PQTER2 RTS
+* Returns flag in A (non-zero if BREAK).
+* Coco:
+PQTER PSHS Y,U,DP
+ CLRB
+ TFR B,DP
+ JSR [$A000]
+ CLRB
+ CMPA #3 break key
+ BNE PQTERN
+ INCB
+ EXG A,B
+PQTERN PULS Y,U,DP,PC
+*
+* PQTER LDA ACIAC Test for 'break' condition
+* ANDA #$11 mask framing error bit and
+** input buffer full
+* BEQ PQTER2
+* LDA ACIAD clear input buffer
+* LDA #01
+*PQTER2 RTS
PAGE
*
* ======>> 185 << code for CR
+* Coco:
PRTCR LDA #$D carriage return ; PCR in 6800 source
- BSR PEMIT
- LDA #$A line feed
- BSR PEMIT
- LDA #$7F rubout
- LDX UP
- LDB XDELAY+1-UORIG,X
-PCR2 DECB
- BMI PQTER2 return if minus
- PSHS B save counter
- BSR PEMIT print RUBOUTs to delay.....
- PULS B
- BRA PCR2 repeat
+ BRA PEMIT Let PEMIT return
+*
+* BSR PEMIT
+* LDA #$A line feed
+* BSR PEMIT
+* LDA #$7F rubout
+* LDX UP
+* LDB XDELAY+1-UORIG,X
+* PCR2 DECB
+* BMI PQTER2 return if minus
+* PSHS B save counter
+* BSR PEMIT print RUBOUTs to delay.....
+* PULS B
+* BRA PCR2 repeat
PAGE