|
DataMuseum.dkPresents historical artifacts from the history of: CP/M |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about CP/M Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 12032 (0x2f00)
Types: TextFile
Names: »PRIMOE.Z80«
└─⟦7303e23ba⟧ Bits:30003507 JET80 System diskette
└─⟦this⟧ »PRIMOE.Z80«
TITLE 'PRIMO.Z80'
;**********************************************************
;* PROGRAMMET SÆTTER SIO1A-CTC0 PÅ FØLJANDE SÆTT: *
;**********************************************************
;* TILLDELNINGAR OCH DEFINITIONER *
;**********************************************************
.Z80
; SENASTE UPPDATERING: 1984-01-03.
; KONSTANTER
CR EQU 0DH ; VAGNRETUR
LF EQU 0AH ; RADFRAMMATNING
BELL EQU 7 ; RING I KLOCKAN
; ZILOG COUNTER TIMER (CTC) PORT NUMMER:
CTC0 EQU 8 ; CTC CHANNEL 0
CTC9600 EQU 00000100B ; TKONST = 9600 BAUD*32
CTC4800 EQU 00001000B ; TKONST = 4800 BAUD*32
CTC1200 EQU 00100000B ; TKONST = 1200 BAUD*32
CTC300 EQU 10000000B ; TKONST = 300 BAUD*32
; LINE PRINTER DEFINITIONER:
LPTCTL EQU 1 ; CONTROL PORT
PAGE
ASEG
ORG 100H
START: LD SP,STACK
JP START2
DEFB 0,0,0,0,0,0,0,0,0,0
DEFAU: DEFB 'B6H1D3S2P0'
DEFB 0,0,0,0,0,0
START2: CALL PNEXT
DEFB CR,LF,LF
DEFB 'INITIATION OF PRINTER/MODEMPORT - ',0
CALL KRYPTO
START1: CALL PNEXT
DEFB LF,LF,LF
DEFB 'BAUDRATE :',0
LD A,(DEFAU+1)
SUB '0'-1
LD B,A
LD DE,5
LD HL,BAUD+20
JR LOOP1A
LOOP1: ADD HL,DE
LOOP1A: DJNZ LOOP1
LD DE,BAUDTX
LD BC,5
LDIR
CALL PNEXT
BAUDTX: DEFB '.....',CR,LF
DEFB 'HANDSHAKING : ',0
LD A,(DEFAU+3)
SUB '0'-1
LD B,A
LD DE,3
LD HL,HAND+2
JR LOOP2A
LOOP2: ADD HL,DE
LOOP2A: DJNZ LOOP2
LD DE,HANDTX
LD BC,3
LDIR
CALL PNEXT
HANDTX: DEFB '...',CR,LF
DEFB 'DATABITS : ',0
LD A,(DEFAU+5)
SUB '0'-1
LD B,A
LD DE,1
LD HL,DATA+8
JR LOOP3A
LOOP3: ADD HL,DE
LOOP3A: DJNZ LOOP3
LD DE,DATATX
LD BC,1
LDIR
CALL PNEXT
DATATX: DEFB '.',CR,LF
DEFB 'STOPBITS : ',0
LD A,(DEFAU+7)
SUB '0'-1
LD B,A
LD DE,3
LD HL,STOP+3
JR LOOP4A
LOOP4: ADD HL,DE
LOOP4A: DJNZ LOOP4
LD DE,STOPTX
LD BC,3
LDIR
CALL PNEXT
STOPTX: DEFB '...',CR,LF
DEFB 'PARITY :',0
LD A,(DEFAU+9)
SUB '0'-1
LD B,A
LD DE,5
LD HL,PARITY+3
JR LOOP5A
LOOP5: ADD HL,DE
LOOP5A: DJNZ LOOP5
LD DE,PARITX
LD BC,5
LDIR
CALL PNEXT
PARITX: DEFB '..... '
DEFB 'Commandstring : ',0
LD HL,DEFAU
LD DE,KOMTX
LD BC,10
LDIR
CALL PNEXT
KOMTX: DEFB '..........',CR,LF,LF
DEFB 'Baudrate Handshaking Databits Stopbits Parity',CR,LF
DEFB '0: 110 0: NO 0: 5 0: 1 0: NONE',CR,LF
DEFB '1: 300 1: YES 1: 6 1: 1.5 1: EVEN',CR,LF
DEFB '2: 600 2: 7 2: 2 2: ODD',CR,LF
DEFB '3: 1200 3: 8',CR,LF
DEFB '4: 2400',CR,LF
DEFB '5: 4800',CR,LF
DEFB '6: 9600',CR,LF
DEFB '7: 19200',CR,LF
DEFB '8: 38400',CR,LF
DEFB '9: 76800',CR,LF,LF
DEFB CR,'I=Init port, N=New default saved, <RET>=no change, commandstring.',CR,LF,0
VAL: CALL PNEXT
DEFB 'Your choice ? '
DEFB 8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,0
LD A,(5DH) ; BUFFERT
CP 'I'
JR NZ,VAL1
CALL PNEXT
DEFB 'I',0
JR INIT1
VAL1: CALL RDCONB
LD HL,CONINB+1
LD A,(HL)
AND A
JP Z,SLUT
CP 1
JR Z,INIT
CALL ANALYS
JP C,ERROR
LD HL,BVAL
LD A,(HL)
LD (DEFAU+1),A
INC HL
LD A,(HL)
LD (DEFAU+3),A
INC HL
LD A,(HL)
LD (DEFAU+5),A
INC HL
LD A,(HL)
LD (DEFAU+7),A
INC HL
LD A,(HL)
LD (DEFAU+9),A
CALL PNEXT
DEFB LF,0
JP START1
INIT: INC HL
LD A,(HL)
RES 5,A
CP 'I'
JP NZ,ERR1
INIT1: LD A,(DEFAU+1)
SUB '0'-1
LD B,A
LD HL,BAUD
JR INLP1A
INLP1: INC HL
INC HL
INLP1A: DJNZ INLP1
LD A,(HL)
LD (CTCR),A
INC HL
LD A,(HL)
LD (WR4),A
LD A,(DEFAU+3)
SUB '0'-1
LD B,A
LD HL,HAND
JR INLP2A
INLP2: INC HL
INLP2A: DJNZ INLP2
LD A,(HL)
LD (WR3),A
LD A,(DEFAU+5)
SUB '0'-1
LD B,A
LD HL,DATA
JR INLP3A
INLP3: INC HL
INC HL
INLP3A: DJNZ INLP3
LD A,(HL)
LD (WR5),A
INC HL
LD A,(HL)
LD HL,WR3
OR (HL)
LD (HL),A
LD A,(DEFAU+7)
SUB '0'-1
LD B,A
LD HL,STOP
JR INLP4A
INLP4: INC HL
INLP4A: DJNZ INLP4
LD A,(HL)
LD HL,WR4
OR (HL)
LD (HL),A
LD A,(DEFAU+9)
SUB '0'-1
LD B,A
LD HL,PARITY
JR INLP5A
INLP5: INC HL
INLP5A: DJNZ INLP5
LD A,(HL)
LD HL,WR4
OR (HL)
LD (HL),A
LD HL,T9600
CALL INISTM
CALL PNEXT
DEFB CR,LF,'..............Printer/Modem port initialized.',CR,LF,0
SLUT: JP 0
ERR1: CP 'N'
JP Z,OPEN
ERROR: CALL PNEXT
DEFB BELL,BELL,0
JP VAL
FEL: SCF
LD HL,BVAL
LD A,(DEFAU+1)
LD (HL),A
INC HL
LD A,(DEFAU+3)
LD (HL),A
INC HL
LD A,(DEFAU+5)
LD (HL),A
INC HL
LD A,(DEFAU+7)
LD (HL),A
INC HL
LD A,(DEFAU+9)
LD (HL),A
RET
ANALYS: RRA ; KOLLA OM UDDA
JR C,FEL
AND 00000111B; ANTAL BYTES
LD C,A
INC C ; ØKA MED 1
ANALY1: OR A
DEC C ; MINSKA MED EN TILL
RET Z
INC HL ; BØR PEKA PÅ TECKEN
LD A,(HL) ; SPAR DETTA
RES 5,A
INC HL ; PARAMETER
CP 'B' ; ÆR DET BAUD
JR Z,ANAB ; JA...HOPPA
CP 'H' ; ÆR DET HAND SHAKE
JR Z,ANAH
CP 'D' ; ÆR DET DATABITAR
JR Z,ANAD
CP 'S' ; ÆR DET STOPPBITAR
JR Z,ANAS
CP 'P' ; ÆR DET PARITET
JR NZ,FEL
ANAP: LD A,(HL)
CP '0'
JR C,FEL
CP '3'
JR NC,FEL
LD (PVAL),A
JR ANALY1
ANAS: LD A,(HL)
CP '0'
JR C,FEL
CP '3'
JR NC,FEL
LD (SVAL),A
JR ANALY1
ANAD: LD A,(HL)
CP '0'
JR C,FEL
CP '4'
JR NC,FEL
LD (DVAL),A
JR ANALY1
ANAB: LD A,(HL)
CP '0'
JR C,FEL
CP '9'+1
JR NC,FEL
LD (BVAL),A
JR ANALY1
ANAH: LD A,(HL)
CP '0'
JR C,FEL
CP '2'
JP NC,FEL
LD (HVAL),A
JR ANALY1
BAUD: DEFB 0AEH,0C0H ; 110 BAUD
DEFB 80H,80H ; 300 BAUD
DEFB 40H,80H ; 600 BAUD
DEFB 20H,80H ; 1200 BAUD
DEFB 10H,80H ; 2400 BAUD
DEFB 08H,80H ; 4800 BAUD
DEFB 04H,80H ; 9600 BAUD
DEFB 02H,80H ; 19200 BAUD
DEFB 01H,80H ; 38400 BAUD
DEFB 01H,40H ; 76800 BAUD
DEFB ' 110'
DEFB ' 300'
DEFB ' 600'
DEFB ' 1200'
DEFB ' 2400'
DEFB ' 4800'
DEFB ' 9600'
DEFB '19200'
DEFB '38400'
DEFB '76800'
HAND: DEFB 0H ; INGEN
DEFB 20H ; JA
DEFB ' NO'
DEFB 'YES'
DATA: DEFB 08AH,001H ; 5 BITS: Tx,Rx
DEFB 0CAH,081H ; 6 BITS: Tx,Rx
DEFB 0AAH,041H ; 7 BITS: Tx,Rx
DEFB 0EAH,0C1H ; 8 BITS: Tx,Rx
DEFB '5'
DEFB '6'
DEFB '7'
DEFB '8'
STOP: DEFB 04H ; 1 STOP-BIT
DEFB 08H ; 1.5 STOP-BITS
DEFB 0CH ; 2 STOP-BITS
DEFB ' 1'
DEFB '1.5'
DEFB ' 2'
PARITY: DEFB 0H ; INGEN
DEFB 03H ; JÆMN
DEFB 01H ; UDDA
DEFB ' NONE'
DEFB ' EVEN'
DEFB ' ODD'
BVAL: DEFB '6'
HVAL: DEFB '1'
DVAL: DEFB '3'
SVAL: DEFB '0'
PVAL: DEFB '0'
; INISTM:
; INITIERAR I/O-PORT FRÅN EN TABELL.
; INGÅNG: HL = ADRESS TILL TABELL AV FØLJANDE
; UTSEENDE:
; SLUT MARKERAS MED BYTE=0.
; BYTE1 = ANTAL BYTES TILL PORT.
; BYTE2 = PORTADRESS.
; BYTE3...BYTEN = DATA TILL PORT.
INISTM:
LD A,(HL) ; KOLLA OM TABELLEN ÆR SLUT
OR A
RET Z ; JA (HL)=0...ÅTER.
LD B,A ; HÆMTA TABELLÆNGD. BYTE-RÆKNARE.
INC HL ; NÆSTA BYTE
LD C,(HL) ; HÆMTA I/O PORT ADRESS.
INC HL ; PEKA PÅ DATA BYTES
OTIR ; SÆND TILL I/O PORT.
JR INISTM ; UPPREPA FØR NÆSTA TABELL.
PAGE
; TABELLER ------------------------------------------------
; 9600 BAUD NO HANDSHAKE.
T9600: DEFB 2,CTC0 ; 2 BYTES TILL CTC0.
DEFB 01000101B ; COUNTER. TIDSKONST FØLJER
CTCR: DEFB CTC9600 ; 9600 BAUD.
DEFB 9,LPTCTL ; 9 BYTES TILL DART B
DEFB 18H ; RESET CHANNEL.
DEFB 14H ; SELECT WRITE REGISTER 4.
WR4: DEFB 10000111B ; X32 CLOCK, 1 STOP BIT, PARITY EVEN
DEFB 13H ; SELECT WRITE REGISTER 3.
WR3: DEFB 11100001B ; NO HARDWARE HANDSHAKE ON DB25 PIN 4.
; RX 8 BITS, RX ENABLE.
DEFB 15H ; SELECT WRITE REGISTER 5.
WR5: DEFB 11101010B ; DTR, TX 8 BITS, TX ENABLE, *RTS LOW.
DEFB 01H ; SELECT WRITE REGISTER 1.
DEFB 0 ; NO INTERRUPTS, UNMODIFIED INTERRUPT
; VECTOR (BOTH CHANNELS).
DEFB 0 ; TABELLSLUT.
;**********************************************************
;* GENERELLA SUBRUTINER *
;**********************************************************
; PCRLF - GER NY RAD
PCRLF: CALL PNEXT
DEFB CR,LF,0
RET
; PNEXT - SKRIVER UT DEN TEXT, SOM OMEDELBART FØLJER
; SUBRUTINANROPET.
; TEXTEN MÅSTE AVSLUTAS AV EN BYTE = 0.
PNEXT: EX (SP),HL ; HL -> TECKENBYTE
LD A,(HL) ; A = TECKENBYTE
INC HL ; NÆSTA BYTE
EX (SP),HL ; BYT TILLBAKA
OR A ; ÆR DET NOLL (SISTA TECKEN)?
RET Z ; JA...ÅTER
LD C,A ; C=TECKEN
CALL CONOUT ; SKRIV DETTA
JR PNEXT ; NÆSTA TECKEN
; RDCONB - GØR ANROP TILL BDOS OCH LÆSER IN BUFFERT.
RDCONB: LD C,10 ; READ CONSOLE BUFFERT
LD DE,CONINB
JP 5
; CONOUT - SKRIVER UT DET TECKEN, SOM FINNS I C PÅ
; CONSOLE.
CONOUT: PUSH HL
LD HL,9
JR GO
GO: PUSH DE ; LAGRA DE
LD DE,(1) ; DE=BIOS-VEKTOR
ADD HL,DE ; ADDERA ØNSKAD VEKTOR
POP DE ; DE ÅTER
EX (SP),HL ; BYT FØR ATT KLARA
RET ; HOPP TILL HL:s LÆGE.
FCB: DEFB 0 ; DEFAULT DRIVE
DEFB 'PRIMO COM'
DEFB 0 ; EXTENT
DEFB 0,0 ; S1,S2
DEFB 0 ; RC
DEFW 0,0,0,0,0,0,0,0
DEFB 0 ; CR
DEFB 0,0,0 ; R0,R1,R2
OPEN: LD C,15 ; OPEN
LD DE,FCB
CALL 5
OR A
JR Z,SETDMA
CALL PNEXT
DEFB CR,LF
DEFB 'Cannot open PRIMO.COM',CR,LF,0
JP 0
SETDMA: LD C,26 ; SETDMA
LD DE,80H
CALL 5
LD C,33 ; READ RANDOM
LD DE,FCB
CALL 5
OR A
JR Z,FLYTTA
CALL PNEXT
DEFB CR,LF
DEFB 'Cannot read PRIMO.COM',CR,LF,0
JP 0
FLYTTA: LD BC,10
LD DE,90H ; TILL ADRESS
LD HL,DEFAU
LDIR
LD C,26 ; SETDMA
LD DE,80H
CALL 5
LD C,34 ; WRITE RANDOM
LD DE,FCB
CALL 5
OR A
JR Z,OK
CALL PNEXT
DEFB CR,LF
DEFB 'Cannot write PRIMO.COM',CR,LF,0
JP 0
OK: CALL PNEXT
DEFB CR,LF
DEFB '..............New default values saved, but not sent to port.',0
JP 0
KRYPTO: LD HL,KOD
LD DE,KOD
LD B,38/2
KRYP1: LD A,(HL) ; LÆGG 1:AN
LD C,A ; I C.
INC HL
LD A,(HL) ; OCH 2:AN I A.
XOR C ; STARTA DEKRYTERING
AND 01010101B
XOR C
AND 01111111B
LD (DE),A ; LAGRA 1:AN.
INC DE
LD A,(HL)
XOR C
AND 10101010B
XOR C
RES 7,A
LD (DE),A ; LAGRA 2:AN.
INC DE
INC HL
DJNZ KRYP1
CALL PNEXT ; SKRIV TEXT
KOD: DEFB ((('C' XOR 'o') AND 55H) XOR 'C') OR 128
DEFB (('C' XOR 'o') AND 0AAH) XOR 'C'
DEFB ((('p' XOR 'y') AND 55H) XOR 'p') OR 128
DEFB (('p' XOR 'y') AND 0AAH) XOR 'p'
DEFB ((('r' XOR 'i') AND 55H) XOR 'r') OR 128
DEFB (('r' XOR 'i') AND 0AAH) XOR 'r'
DEFB ((('g' XOR 'h') AND 55H) XOR 'g') OR 128
DEFB (('g' XOR 'h') AND 0AAH) XOR 'g'
DEFB ((('t' XOR ' ') AND 55H) XOR 't') OR 128
DEFB (('t' XOR ' ') AND 0AAH) XOR 't'
DEFB ((('(' XOR 'C') AND 55H) XOR '(') OR 128
DEFB (('(' XOR 'C') AND 0AAH) XOR '('
DEFB (((')' XOR ' ') AND 55H) XOR ')') OR 128
DEFB ((')' XOR ' ') AND 0AAH) XOR ')'
DEFB ((('1' XOR '9') AND 55H) XOR '1') OR 128
DEFB (('1' XOR '9') AND 0AAH) XOR '1'
DEFB ((('8' XOR '4') AND 55H) XOR '8') OR 128
DEFB (('8' XOR '4') AND 0AAH) XOR '8'
DEFB (((',' XOR ' ') AND 55H) XOR ',') OR 128
DEFB ((',' XOR ' ') AND 0AAH) XOR ','
DEFB ((('J' XOR 'e') AND 55H) XOR 'J') OR 128
DEFB (('J' XOR 'e') AND 0AAH) XOR 'J'
DEFB ((('t' XOR ' ') AND 55H) XOR 't') OR 128
DEFB (('t' XOR ' ') AND 0AAH) XOR 't'
DEFB ((('C' XOR 'o') AND 55H) XOR 'C') OR 128
DEFB (('C' XOR 'o') AND 0AAH) XOR 'C'
DEFB ((('m' XOR 'p') AND 55H) XOR 'm') OR 128
DEFB (('m' XOR 'p') AND 0AAH) XOR 'm'
DEFB ((('u' XOR 't') AND 55H) XOR 'u') OR 128
DEFB (('u' XOR 't') AND 0AAH) XOR 'u'
DEFB ((('e' XOR 'r') AND 55H) XOR 'e') OR 128
DEFB (('e' XOR 'r') AND 0AAH) XOR 'e'
DEFB (((' ' XOR 'C') AND 55H) XOR ' ') OR 128
DEFB ((' ' XOR 'C') AND 0AAH) XOR ' '
DEFB ((('o' XOR 'r') AND 55H) XOR 'o') OR 128
DEFB (('o' XOR 'r') AND 0AAH) XOR 'o'
DEFB ((('p' XOR '.') AND 55H) XOR 'p') OR 128
DEFB (('p' XOR '.') AND 0AAH) XOR 'p'
DEFB CR,LF,0
RET
CONINB: DEFB 10 ; CONSOLE-BUFFERT MAX 5 TECKEN.
DEFS 12 ; RÆKNARE OCH BUFFERT
DEFS 100
STACK EQU $
END
«eof»