mirror of https://github.com/wwarthen/RomWBW.git
You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
235 lines
4.1 KiB
235 lines
4.1 KiB
TITLE TTYDRV - FORTRAN-80 TTY I/O DRIVER
|
|
|
|
.8080
|
|
|
|
EXTRN $IOERR,$BL,$BF,$ERR,$TTYIN,$TTYOT
|
|
|
|
; TTY: & PUN:/RDR: DRIVER ENTRIES:
|
|
|
|
ENTRY TTYDRV,PUNRDR
|
|
|
|
; FORTRAN-80 UTILITY SUBROUTINES:
|
|
|
|
ENTRY PUNCH,READER,GOTOXY,SCREEN
|
|
ENTRY HOME,INKEY,CONOUT
|
|
|
|
DSEG
|
|
|
|
DEVFLG: DB 0
|
|
|
|
CSEG
|
|
|
|
PUNRDR: DW PUNFR ;FORMATTED READ
|
|
DW PUNFW ;FORMATTED WRITE
|
|
DW $IOERR ;UNFORMATTED READ
|
|
DW PUNUWR ;UNFORMATTED WRITE
|
|
DW NULL ;REWIND
|
|
DW NULL ;BACKSPACE
|
|
DW NULL ;ENDFILE
|
|
|
|
TTYDRV: DW TTYFR ;SAME AS ABOVE
|
|
DW TTYFW
|
|
DW $IOERR
|
|
DW TTYUWR
|
|
DW NULL
|
|
DW NULL
|
|
DW NULL
|
|
|
|
TTYFR: XRA A ;TTY = 0
|
|
DB 1 ;SKIP 2 BYTES WITH 'LXI B,'
|
|
|
|
PUNFR: MVI A,1 ;READER = 1
|
|
STA DEVFLG ;DEVICE FLAG
|
|
|
|
XRA A
|
|
MOV E,A ;ZERO LO BYTE OF $BL
|
|
STA $BL+1 ;ZERO HI BYTE
|
|
|
|
LHLD $BF ;GET BUFFER ADDR
|
|
|
|
DRV31: CALL INCHR ;GET A CHARACTER
|
|
DRV39: CPI 10 ;INGNORE LINE FEEDS
|
|
JZ DRV31
|
|
|
|
MOV M,A
|
|
|
|
INX H
|
|
INR E
|
|
|
|
CPI 13 ;TEST FOR END OF LINE
|
|
MOV A,E
|
|
STA $BL
|
|
RZ
|
|
|
|
CPI 132 ;MAX 132 CHARS
|
|
JC DRV31
|
|
|
|
CALL $ERR ;GIVE 'INPUT RECORD TOO LONG' WARNING
|
|
DB 18
|
|
|
|
NULL: XRA A ;CLEAR CARRY AND ZERO FLAGS
|
|
RET
|
|
|
|
TTYFW: XRA A ;TTY = 0
|
|
DB 1 ;SKIP 2 WITH 'LXI B,'
|
|
|
|
PUNFW: MVI A,1 ;PUNCH = 1
|
|
STA DEVFLG
|
|
|
|
LDA $BL ;GET BUFFER LENGTH
|
|
ORA A
|
|
RZ ;EMPTY BUFFER - JUST RETURN
|
|
|
|
LHLD $BF ;BUFFER ADDRESS
|
|
DCR A
|
|
MOV E,A ;SAVE LENGTH IN [E]
|
|
|
|
MOV A,M ;GET CARRIAGE CONTROL CHAR
|
|
CPI '*' ;DO NOTHING?
|
|
JZ TTYNOT
|
|
|
|
CALL OUTCR ;PRINT A CARRIAGE RETURN
|
|
MOV A,M ;REGET FIRST CHAR
|
|
CPI '+' ;A '+' MEANS CR BUT NO LF
|
|
JZ TTYNOT
|
|
|
|
CPI '1' ;A '1' MEANS CLEAR SCREEN/FORM FEED
|
|
JNZ TTYLFO
|
|
CALL HOM1 ;GO CLEAR SCREEN OR SEND FF CHAR
|
|
JMP TTYNOT
|
|
|
|
TTYLFO: CALL OUTLF ;PRINT A LINE FEED
|
|
� MOV A,M ;GET CARR CONTROL CHAR BACK
|
|
CPI '0' ;'0' MEANS DOUBLE SPACING
|
|
CZ OUTLF ;ANYTHING ELSE IS JUST SINGLE SPACING
|
|
|
|
TTYNOT: INX H ;INCREMENT BUFFER POINTER
|
|
MVI D,0 ;HI BYTE OF COUNT = 0
|
|
|
|
TTYLOP: MOV A,E ;DONE SENDING CHARACTERS?
|
|
ORA D
|
|
RZ ;YES, RETURN
|
|
MOV C,M ;GET CHARACTER INTO [C]
|
|
CALL OUTCH ;SEND THE CHAR
|
|
INX H ;INC BUFFER PTR
|
|
DCX D ;DEC CHARACTER COUNT
|
|
JMP TTYLOP
|
|
|
|
TTYUWR: XRA A
|
|
|
|
DB 1 ;SKIP 2 WITH 'LXI B,'
|
|
|
|
PUNUWR: MVI A,1
|
|
STA DEVFLG
|
|
LHLD $BL ;GET NO. OF CHARS TO SEND
|
|
XCHG ;INTO [DE]
|
|
LHLD $BF ;GET BUFFER POINTER INTO [HL]
|
|
JMP TTYLOP ;AND GO SEND THEM
|
|
|
|
OUTLF: MVI C,10 ;OUTPUT A LINE FEED
|
|
JMP OUTCH
|
|
|
|
OUTCR: MVI C,13 ;OUTPUT A CARRIAGE RETURN
|
|
|
|
OUTCH: LDA DEVFLG ;PRINT CHARACTER TO EITHER
|
|
ORA A ;TTY: OR PUN: DEVICE
|
|
MOV A,C
|
|
JNZ $PUNOT
|
|
JMP $TTYOT
|
|
|
|
PUNCH: MOV A,M ;FORTRAN PUNCH SUBROUTINE
|
|
|
|
$PUNOT: PUSH B
|
|
PUSH D
|
|
MVI C,4 ;CP/M PUNCH DEVICE OUTPUT
|
|
MOV E,A
|
|
GOCPM: PUSH H
|
|
CALL 5
|
|
POP H
|
|
POP D
|
|
POP B
|
|
RET
|
|
|
|
CONOUT: MOV A,M ;FORTRAN CONOUT SUBROUTINE
|
|
JMP $TTYOT
|
|
|
|
READER: ;FORTRAN READER FUNCTION
|
|
|
|
$RDRIN: PUSH B
|
|
PUSH D
|
|
MVI C,3
|
|
JMP GOCPM
|
|
|
|
INCHR: LDA DEVFLG ;GET CHAR FROM EITHER
|
|
ORA A ;TTY OR READER DEVICE
|
|
JNZ $RDRIN
|
|
JMP $TTYIN
|
|
|
|
HOM1: LDA DEVFLG ;CLEAR SCREEN IF TTY,
|
|
ORA A ;SEND FF CHAR IF PUNCH
|
|
JZ HOME
|
|
MVI A,12 ;FF CHAR
|
|
JMP $PUNOT
|
|
|
|
HOME: MVI A,1 ;CLEAR CONSOLE SCREEN
|
|
JMP DOFUN
|
|
|
|
SCREEN: MOV A,M ;GET FUNCTION #
|
|
|
|
DOFUN: PUSH H
|
|
LXI H,0F397H ;SSFTAB
|
|
ADD L ;POINT TO DESIRED FUN CHAR
|
|
MOV L,A
|
|
MOV A,M ;GET IT INTO A
|
|
ORA A ;REQUIRE LEAD-IN?
|
|
JP NOLDIN
|
|
PUSH PSW
|
|
LDA 0F397H ;YES, SO SEND IT FIRST
|
|
CALL $TTYOT
|
|
POP PSW
|
|
NOLDIN: CALL $TTYOT
|
|
POP H
|
|
RET
|
|
|
|
GOTOXY: MVI A,7 ;DO CURSOR POSITION FUNCTION
|
|
CALL DOFUN
|
|
|
|
LDAX D ;GET COORDS
|
|
MOV H,M ;H=X, L=Y
|
|
MOV L,A
|
|
|
|
DCR L ;MAP 1..24,1..80 TO 0..23,0..79
|
|
DCR H
|
|
|
|
LDA 0F396H ;XY COORD OFFSET
|
|
ORA A
|
|
JP NORVS
|
|
|
|
MOV E,L ;SWAP
|
|
MOV L,H
|
|
MOV H,E
|
|
|
|
NORVS: MOV E,A ;SAVE IN [E]
|
|
ADD H ;ADD OFFSET
|
|
PUSH PSW ;SAVE CHAR
|
|
MOV A,E
|
|
ADD L ;OUTPUT FIRST COORD
|
|
CALL $TTYOT
|
|
POP PSW
|
|
MOV E,A ;OUTPUT SECOND COORD
|
|
JMP $TTYOT
|
|
|
|
INKEY: MOV A,M ;GET PARAMETER
|
|
ORA A ;SEE WHAT IT IS
|
|
JZ INK1 ;ZERO - JUST TEST STATUS
|
|
|
|
INKLP: CALL INK1 ;READ CONSOLE STATUS
|
|
ORA A
|
|
JZ INKLP ;WAIT UNTIL KEYPRESS
|
|
RET
|
|
|
|
INK1: MVI C,6 ;CONSOLE STATUS CALL
|
|
MVI E,255
|
|
JMP 5 ;GO TO BDOS
|
|
|
|
END
|