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

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