seppdroid/Digital-Research-Source-Code
1
0
Fork 0
mirror of https://github.com/SEPPDROID/Digital-Research-Source-Code.git synced 2025-10-23 00:14:25 +00:00
Code Issues Actions Packages Projects Releases Wiki Activity

Upload

Browse Source 
Digital Research
This commit is contained in:
Sepp J Morris
2020-11-06 18:50:37 +01:00
parent 621ed8ccaf
commit 31738079c4
8481 changed files with 1888323 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

46
CPM OPERATING SYSTEMS/CPM 2.X/CPM 2.0/as0com.asm Normal file
View File

@@ -0,0 +1,46 @@
TITLE 'ASM COMMON DATA AREA'
;
; COPYRIGHT (C) 1977, 1978
; DIGITAL RESEARCH
; BOX 579, PACIFIC GROVE
; CALIFORNIA, 93950
;
; COMMON DATA FOR CP/M ASSEMBLER MODULE
ORG 100H
ENDA EQU 20F0H ;END OF ASSEMBLER PROGRAM
BDOS EQU 5H ;ENTRY TO DOS, USED TO COMPUTE END MEMORY
LXI SP,ENDMOD
LHLD BDOS+1
SHLD SYMAX ;COMPUTE END OF MEMORY
JMP ENDMOD
COPY: DB ' COPYRIGHT(C) 1978, DIGITAL RESEARCH '
ORG COPY
;
; PRINT BUFFER AND PRINT BUFFER POINTER
PBMAX EQU 120 ;MAX PRINT BUFFER
PBUFF: DS PBMAX
PBP: DS 1 ;PRINT BUFFER POINTER
;
; SCANNER PARAMETERS
TOKEN: DS 1 ;CURRENT TOKEN
VALUE: DS 2 ;BINARY VALUE FOR NUMBERS
ACCLEN: DS 1 ;ACCUMULATOR LENGTH
ACMAX EQU 64 ;LENGTH OF ACCUMULATOR
ACCUM: DS ACMAX ;ACCUMULATOR (MUST FOLLLOW ACCLEN)
;
; OPERAND EXPRESSION EVALUATOR PARAMETERS
EVALUE: DS 2 ;VALUE OF EXPRESSION AFTER EVALUATION
;
; SYMBOL TABLE MODULE PARAMETERS
SYTOP: DW ENDA ;FIRST LOCATION AVAILABLE FOR SYMBOL TABLE
SYMAX: DS 2 ;LAST AVAILABLE LOCATION FOR SYMBOL TABLE
;
; MISCELLANEOUS DATA AREAS
PASS: DS 1 ;PASS # 0,1
FPC: DS 2 ;FILL ADDRESS FOR NEXT HEX RECORD
ASPC: DS 2 ;ASSEMBLER'S PSEUDO PC
SYBAS: DW ENDA ;SYMBOL TABLE BASE
SYADR: DS 2 ;CURRENT SYMBOL BASE
ENDMOD EQU ($ AND 0FF00H)+100H
END


727
CPM OPERATING SYSTEMS/CPM 2.X/CPM 2.0/as1io.asm Normal file
View File

@@ -0,0 +1,727 @@
TITLE 'ASM IO MODULE'
; I/O MODULE FOR CP/M ASSEMBLER
;
ORG 200H
BOOT EQU 000H ;REBOOT LOCATION
; I/O MODULE ENTRY POINTS
JMP INIT ;INITIALIZE, START ASSEMBLER
JMP SETUP ;FILE SETUP
JMP GNC ;GET NEXT CHARACTER
JMP PNC ;PUT NEXT OUTPUT CHARACTER
JMP PNB ;PUT NEXT HEX BYTE
JMP PCHAR ;PRINT CONSOLE CHARACTER
JMP PCON ;PRINT CONSOLE BUFFER TO CRLF
JMP WOBUFF ;WRITE OUTBUFFER
JMP PERR ;PLACE ERROR CHARACTER INTO PBUFF
JMP DHEX ;PLACE HEX BYTE INTO OUTPUT BUFFER
JMP EOR ;END OF ASSEMBLY
; DATA FOR I/O MODULE
BPC: DS 2 ;BASE PC FOR CURRENT HEX RECORD
DBL: DS 1 ;HEX BUFFER LENGTH
DBUFF: DS 16 ;HEX BUFFER
;
; DISK NAMES
CDISK: DS 1 ;CURRENTLY SELECTED DISK
ADISK: DS 1 ;.ASM DISK
PDISK: DS 1 ;.PRN DISK
HDISK: DS 1 ;.HEX DISK
;
;
;
; COMMON EQUATES
QBMAX EQU 120 ;MAX PRINT SIZE
QBUFF EQU 10CH ;PRINT BUFFER
QBP EQU QBUFF+QBMAX ;PRINT BUFFER POINTER
;
TOKEN EQU QBP+1 ;CURRENT TOKEN UDER SCAN
VALUE EQU TOKEN+1 ;VALUE OF NUMBER IN BINARY
ACCLEN EQU VALUE+2 ;ACCUMULATOR LENGTH
ACMAX EQU 64 ;MAX ACCUMULATOR LENGTH
ACCUM EQU ACCLEN+1
;
EVALUE EQU ACCUM+ACMAX ;VALUE FROM EXPRESSION ANALYSIS
;
SYTOP EQU EVALUE+2 ;CURRENT SYMBOL TOP
SYMAX EQU SYTOP+2 ;MAX ADDRESS+1
;
PASS EQU SYMAX+2 ;CURRENT PASS NUMBER
FPC EQU PASS+1 ;FILL ADDRESS FOR DHEX ROUTINE
ASPC EQU FPC+2 ;ASSEMBLER'S PSEUDO PC
;
CR EQU 0DH ;CARRIAGE RETURN
LF EQU 0AH ;LINE FEED
EOF EQU 1AH ;END OF FILE MARK
;
;
; DOS ENTRY POINTS
BDOS EQU 5H ;DOS ENTRY POINT
READC EQU 1 ;READ CONSOLE DEVICE
WRITC EQU 2 ;WRITE CONSOLE DEVICE
REDYC EQU 11 ;CONSOLE CHARACTER READY
SELECT EQU 14 ;SELECT DISK SPECIFIED BY REGISTER E
OPENF EQU 15 ;OPEN FILE
CLOSF EQU 16 ;CLOSE FILE
DELEF EQU 19 ;DELETE FILE
READF EQU 20 ;READ FILE
WRITF EQU 21 ;WRITE FILE
MAKEF EQU 22 ;MAKE A FILE
CSEL EQU 25 ;RETURN CURRENTLY SELECTED DISK
SETDM EQU 26 ;SET DMA ADDRESS
;
; FILE AND BUFFERING PARAMETERS
NSB EQU 8 ;NUMBER OF SOURCE BUFFERS
NPB EQU 6 ;NUMBER OF PRINT BUFFERS
NHB EQU 6 ;NUMBER OF HEX BUFFERS
;
SSIZE EQU NSB*128
PSIZE EQU NPB*128
HSIZE EQU NHB*128
;
; FILE CONTROL BLOCKS
SCB: DS 9 ;FILE NAME
DB 'ASM' ;FILE TYPE
SCBR: DS 1 ;REEL NUMBER (ZEROED IN SETUP)
DS 19 ;MISC AND DISK MAP
SCBCR: DS 1 ;CURRENT RECORD (ZEROED IN SETUP)
;
PCB: DS 9
DB 'PRN',0
DS 19
DB 0 ;RECORD TO WRITE NEXT
;
HCB: DS 9
DB 'HEX',0
DS 19
DB 0
;
; POINTERS AND BUFFERS
SBP: DW SSIZE ;NEXT CHARACTER POSITION TO READ
SBUFF: DS SSIZE
;
PBP: DW 0
PBUFF: DS PSIZE
;
HBP: DW 0
HBUFF: DS HSIZE
FCB EQU 5CH ;FILE CONTROL BLOCK ADDRESS
FNM EQU 1 ;POSITION OF FILE NAME
FLN EQU 9 ;FILE NAME LENGTH
BUFF EQU 80H ;INPUT DISK BUFFER ADDRESS
;
SEL: ;SELECT DISK IN REG-A
LXI H,CDISK
CMP M ;SAME?
RZ
MOV M,A ;CHANGE CURRENT DISK
MOV E,A
MVI C,SELECT
CALL BDOS
RET
;
SCNP: ;SCAN THE NEXT PARAMETER
INX H
MOV A,M
CPI ' '
JZ SCNP0
SBI 'A' ;NORMALIZE
RET
SCNP0: LDA CDISK
RET
;
PCON: ;PRINT MESSAGE AT H,L TO CONSOLE DEVICE
MOV A,M
CALL PCHAR
MOV A,M
INX H
CPI CR
JNZ PCON
MVI A,LF
CALL PCHAR
RET
;
FNAME: ;FILL NAME FROM DEFAULT FILE CONTROL BLOCK
LXI D,FCB
MVI B,FLN
FNAM0: LDAX D ;GET NEXT FILE CHARACTER
CPI '?'
JZ FNERR ;FILE NAME ERROR
MOV M,A ;STORE TO FILE CNTRL BLOCK
INX H
INX D
DCR B
JNZ FNAM0 ;FOR NEXT CHARACTER
RET
;
INIT: ;SET UP STACK AND FILES, START ASSEMBLER
LXI H,TITL
CALL PCON
JMP SET0
;
OPEN: ;OPEN FILE ADDRESSED BY D,E
MVI C,OPENF
CALL BDOS
CPI 255
RNZ
; OPEN ERROR
LXI H,ERROP
CALL PCON
JMP BOOT
;
CLOSE: ;CLOSE FILE ADDRESSED BY D,E
MVI C,CLOSF
CALL BDOS
CPI 255
RNZ ;CLOSE OK
LXI H,ERRCL
CALL PCON
JMP BOOT
;
DELETE: ;DELETE FILE ADDRESSED BY D,E
MVI C,DELEF
JMP BDOS
;
MAKE: ;MAKE FILE ADDRESSED BY D,E
MVI C,MAKEF
CALL BDOS
CPI 255
RNZ
; MAKE ERROR
LXI H,ERRMA
CALL PCON
JMP BOOT
;
SELA: LDA ADISK
CALL SEL
RET
;
NPR: ;RETURN ZERO FLAG IF NO PRINT FILE
LDA PDISK
CPI 'Z'-'A'
RZ
CPI 'X'-'A' ;CONSOLE
RET
;
SELP: LDA PDISK
CALL SEL
RET
;
SELH: LDA HDISK
CALL SEL
RET
;
SET0: ;SET UP FILES FOR INPUT AND OUTPUT
LDA FCB ;GET FIRST CHARACTER
CPI ' ' ;MAY HAVE FORGOTTEN NAME
JZ FNERR ;FILE NAME ERROR
MVI C,CSEL ;CURRENT DISK?
CALL BDOS ;GET IT TO REG-A
STA CDISK
;
; SCAN PARAMETERS
LXI H,FCB+FLN-1
CALL SCNP
STA ADISK
CALL SCNP
STA HDISK
CALL SCNP
STA PDISK
;
LXI H,SCB ;ADDRESS SOURCE FILE CONTROL BLOCK
CALL FNAME ;FILE NAME OBTAINED FROM DEFAULT FCB
;
CALL NPR ;Z OR X?
JZ NOPR
LXI H,PCB ;ADDRESS PRINT FILE CONTROL BLOCK
PUSH H ;SAVE A COPY FOR OPEN
PUSH H ;SAVE A COPY FOR DELETE
CALL FNAME ;FILL PCB
CALL SELP
POP D ;FCB ADDRESS
CALL DELETE
POP D ;FCB ADDRESS
CALL MAKE
;
NOPR: ;TEST FOR HEX FILE
LDA HDISK
CPI 'Z'-'A'
JZ NOHEX
LXI H,HCB
PUSH H
PUSH H
CALL FNAME
CALL SELH
POP D
CALL DELETE
POP D
CALL MAKE
;
; FILES SET UP, CALL ASSEMBLER
NOHEX: JMP ENDMOD
;
SETUP: ;SETUP INPUT FILE FOR SOURCE PROGRAM
LXI H,SSIZE
SHLD SBP ;CAUSE IMMEDIATE READ
XRA A ;ZERO VALUE
STA SCBR ;CLEAR REEL NUMBER
STA SCBCR ;CLEAR CURRENT RECORD
STA DBL ;CLEAR HEX BUFFER LENGTH
CALL SELA
LXI D,SCB
CALL OPEN
;
RET
;
FNERR: ;FILE NAME ERROR
LXI H,ERRFN
CALL PCON
JMP BOOT
;
;
GCOMP: ;COMPARE D,E AGAINS H,L
MOV A,D
CMP H
RNZ
MOV A,E
CMP L
RET
;
GNC: ;GET NEXT CHARACTER FROM SOURCE BUFFER
PUSH B
PUSH D
PUSH H ;ENVIRONMENT SAVED
LHLD SBP
LXI D,SSIZE
CALL GCOMP
JNZ GNC2
;
; READ ANOTHER BUFFER
CALL SELA
LXI H,0
SHLD SBP
MVI B,NSB ;NUMBER OF SOURCE BUFFERS
LXI H,SBUFF
GNC0: ;READ 128 BYTES
PUSH B ;SAVE COUNT
PUSH H ;SAVE BUFFER ADDRESS
MVI C,READF
LXI D,SCB
CALL BDOS ;PERFORM THE READ
POP H ;RESTORE BUFFER ADDRESS
POP B ;RESTORE BUFFER COUNT
ORA A ;SET FLAGS
MVI C,128
JNZ GNC1
; NORMAL READ OCCURRED
LXI D,BUFF ;SOURCE BUFFER ADDRESS
MVI C,128
MOV0: LDAX D ;GET CHARACTER
MOV M,A ;STORE CHARACTER
INX D
INX H
DCR C
JNZ MOV0
; BUFFER LOADED, TRY NEXT BUFFER
;
DCR B
JNZ GNC0
JMP GNC2
;
GNC1: ;EOF OR ERROR
CPI 3 ;ALLOW 0,1,2
JNC FRERR ;FILE READ ERROR
GNCE: MVI M,EOF ;STORE AND END OF FILE CHARACTER
INX H
DCR C
JNZ GNCE ;FILL CURRENT BUFFER WITH EOF'S
;
GNC2: ;GET CHARACTER TO ACCUMULATOR AND RETURN
LXI D,SBUFF
LHLD SBP
PUSH H ;SAVE CURRENT SBP
INX H ;READY FOR NEXT READ
SHLD SBP
POP H ;RESTORE PREVIOUS SBP
DAD D ;ABSOLUTE ADDRESS OF CHARACTER
MOV A,M ;GET IT
POP H
POP D
POP B
RET
;
FRERR: LXI H,ERRFR
CALL PCON ;PRINT READ ERROR MESSAGE
JMP BOOT
;
PNC: ;SAME AT PNCF, BUT ENVIRONMENT IS SAVED FIRST
PUSH B
; CHECK FOR CONSOLE OUTPUT / NO OUTPUT
MOV B,A ;SAVE CHARACTER
LDA PDISK ;Z OR X?
CPI 'Z'-'A' ;Z NO OUTPUT
JZ PNRET
;
CPI 'X'-'A'
MOV A,B ;RECOVER CHAR FOR CON OUT
JNZ PNGO
CALL PCHAR
JMP PNRET
;
; NOT X OR Z, SO PRINT IT
PNGO: PUSH D
PUSH H
CALL PNCF
POP H
POP D
PNRET: POP B
RET
;
PNCF: ;PRINT NEXT CHARACTER
LHLD PBP
XCHG
LXI H,PBUFF
DAD D
MOV M,A ;CHARACTER STORED AT PBP IN PBUFF
XCHG ;PBP TO H,L
INX H ;POINT TO NEXT CHARACTER
SHLD PBP ;REPLACE IT
XCHG
LXI H,PSIZE
CALL GCOMP ;AT END OF BUFFER?
RNZ ;RETURN IF NOT
;
; OVERFLOW, WRITE BUFFER
CALL SELP
LXI H,0
SHLD PBP
LXI H,PBUFF
LXI D,PCB ;D,E ADDRESS FILE CONTROL BLOCK
MVI B,NPB ;NUMBER OF BUFFERS TO B
; (DROP THROUGH TO WBUFF)
;
WBUFF: ;WRITE BUFFERS STARTING AT H,L FOR B BUFFERS
; CHECK FOR EOF'S
MOV A,M
CPI EOF
RZ ;DON'T DO THE WRITE
;
PUSH B ;SAVE NUMBER OF BUFFERS
PUSH D ;SAVE FCB ADDRESS
MVI C,128 ;READY FOR MOVE
LXI D,BUFF
WBUF0: ;MOVE TO BUFFER
MOV A,M ;GET CHARACTER
STAX D ;PUT CHARACTER
INX H
INX D
DCR C
JNZ WBUF0
;
; WRITE BUFFER
POP D ;RECOVER FCB ADDRESS
PUSH D ;SAVE IT AGAIN FOR LATER
PUSH H ;SAVE BUFFER ADDRESS
MVI C,WRITF ;DOS WRITE FUNCTION
CALL BDOS
POP H ;RECOVER BUFFER ADDRESS
POP D ;RECOVER FCB ADDRESS
POP B ;RECOVER BUFFER COUNT
ORA A ;SET ERROR RETURN FLAGS
JNZ FWERR
;
; WRITE OK
DCR B
RZ ;RETURN IF NO MORE BUFFERS TO WRITE
JMP WBUFF
;
FWERR: ;ERROR IN WRITE
LXI H,ERRFW
CALL PCON ;ERROR MESSAGE OUT
JMP EORC ;TO CLOSE AND REBOOT
;
;
PNB: ;PUT NEXT HEX BYTE
PUSH B
PUSH D
PUSH H
CALL PNBF
POP H
POP D
POP B
RET
;
PNBF: ;PUT NEXT BYTE
; (SIMILAR TO THE PNCF SUBROUTINE)
LHLD HBP
XCHG
LXI H,HBUFF
DAD D
MOV M,A ;CHARACTER STORED AT HBP IN HBUFF
XCHG
INX H ;HBP INCREMENTED
SHLD HBP
XCHG ;BACK TO D,E
LXI H,HSIZE
CALL GCOMP ;EQUAL?
RNZ
;
; OVERFLOW, WRITE BUFFERS
CALL SELH
LXI H,0
SHLD HBP
LXI H,HBUFF
LXI D,HCB ;FILE CONTROL BLOCK FOR HEX FILE
MVI B,NHB
JMP WBUFF ;WRITE BUFFERS
;
PCHAR: ;PRINT CHARACTER IN REGISTER A
PUSH B
PUSH D
PUSH H
MVI C,WRITC
MOV E,A
CALL BDOS
POP H
POP D
POP B
RET
;
WOCHAR: ;WRITE CHARACTER IN REG-A WITH REFLECT AT CONSOLE IF ERROR
MOV C,A ;SAVE THE CHAR
CALL PNC ;PRINT CHAR
LDA QBUFF
CPI ' '
RZ
; ERROR IN LINE
LDA PDISK
CPI 'X'-'A'
RZ ;ALREADY PRINTED IF 'X'
;
MOV A,C ;RECOVER CHARACTER
CALL PCHAR ;PRINT IT
RET
;
WOBUFF: ;WRITE THE OUTPUT BUFFER TO THE PRINT FILE
LDA QBP ;GET CHARACTER COUNT
LXI H,QBUFF ;BASE OF BUFFER
WOB0: ORA A ;ZERO COUNT?
JZ WOBE
; NOT END, SAVE COUNT AND GET CHARACTER
MOV B,A ;SAVE COUNT
MOV A,M
CALL WOCHAR ;WRITE CHARACTER
INX H ;ADDRESS NEXT CHARACTER OF BUFFER
MOV A,B ;GET COUNT
DCR A
JMP WOB0
;
WOBE: ;END OF PRINT - ZERO QBP
STA QBP
; FOLLOW BY CR LF
MVI A,CR
CALL WOCHAR
MVI A,LF
CALL WOCHAR
LXI H,QBUFF
MVI A,QBMAX ;READY TO BLANK OUT
WOB2: MVI M,' '
INX H
DCR A
JNZ WOB2
RET
;
;
PERR: ;FILL QBUFF ERROR MESSAGE POSITION
MOV B,A ;SAVE CHARACTER
LXI H,QBUFF
MOV A,M
CPI ' '
RNZ ;DON'T CHANGE IT IF ALREADY SET
MOV M,B ;STORE ERROR CHARACTER
RET
;
EOR: ;END OF ASSEMBLER
CALL NPR ;Z OR A?
JZ EOPR
; FILL OUTPUT FILES WITH EOF'S
EOR2: LHLD PBP
MOV A,L
ORA H ;VALUE ZERO?
JZ EOPR
MVI A,EOF ;CTL-Z IS END OF FILE
CALL PNC ;PUT ENDFILES IN PRINT BUFFER
JMP EOR2 ;EVENTUALLY BUFFER IS WRITTEN
;
EOPR: ;END OF PRINT FILE, CHECK HEX
LDA HDISK
CPI 'Z'-'A'
JZ EORC
EOR0: ;WRITE TERMINATING RECORD INTO HEX FILE
LDA DBL ;MAY BE ZERO ALREADY
ORA A
CNZ WHEX ;WRITE HEX BUFFER IF NOT ZERO
LHLD FPC ;GET CURRENT FPC AS LAST ADDRESS
SHLD BPC ;RECORD LENGTH ZERO, BASE ADDRESS 0000
CALL WHEX ;WRITE HEX BUFFER
;
; NOW CLEAR OUTPUT BUFFER FOR HEX FILE
EOR1: LHLD HBP
MOV A,L
ORA H
JZ EORC
MVI A,EOF
CALL PNB
JMP EOR1
;
; CLOSE FILES AND TERMINATE
EORC:
CALL NPR
JZ EORPC
CALL SELP
LXI D,PCB
CALL CLOSE
EORPC:
LDA HDISK
CPI 'Z'-'A'
JZ EORHC
CALL SELH
LXI D,HCB
CALL CLOSE
;
EORHC:
LXI H,ENDA
CALL PCON
JMP BOOT
;
TITL: DB 'CP/M ASSEMBLER - VER 1.4',CR
ERROP: DB 'NO SOURCE FILE PRESENT',CR
ERRMA: DB 'NO DIRECTORY SPACE',CR
ERRFN: DB 'SOURCE FILE NAME ERROR',CR
ERRFR: DB 'SOURCE FILE READ ERROR',CR
ERRFW: DB 'OUTPUT FILE WRITE ERROR',CR
ERRCL: DB 'CANNOT CLOSE FILES',CR
ENDA: DB 'END OF ASSEMBLY',CR
;
DHEX: ;DATA TO HEX BUFFER (BYTE IN REG-A)
PUSH B
MOV B,A ;HOLD CHARACTER FOR 'Z' TEST
LDA HDISK
CPI 'Z'-'A'
MOV A,B ;RECOVER CHARACTER
JZ DHRET
PUSH D ;ENVIRONMENT SAVED
PUSH PSW ;SAVE DATA BYTE
LXI H,DBL ;CURRENT LENGTH
MOV A,M ;TO ACCUM
ORA A ;ZERO?
JZ DHEX3
;
; LENGTH NOT ZERO, MAY BE FULL BUFFER
CPI 16
JC DHEX1 ;BR IF LESS THAN 16 BYTES
; BUFFER FULL, DUMP IT
CALL WHEX ;DBL = 0 UPON RETURN
JMP DHEX3 ;SET BPC AND DATA BYTE
;
DHEX1: ;PARTIAL BUFFER IN PROGRESS, CHECK FOR SEQUENTIAL BYTE LOAD
LHLD FPC
XCHG
LHLD BPC ;BASE PC IN H,L
MOV C,A ;CURRENT LENGTH OF BUFFER
MVI B,0 ;IS IN B,C
DAD B ;BPC+DBL TO H,L
MOV A,E ;READY FOR COMPARE
CMP L ;EQUAL?
JNZ DHEX2 ;BR IF NOT
MOV A,D ;CHECK HO BYTE
CMP H
JZ DHEX4 ;BR IF SAME ADDRESS
;
DHEX2: ;NON SEQUENTIAL ADDRESS, DUMP AND CHANGE BASE ADDRESS
CALL WHEX
DHEX3: ;SET NEW BASE
LHLD FPC
SHLD BPC
;
DHEX4: ;STORE DATA BYTE AND INC DBL
LXI H,DBL
MOV E,M ;LENGTH TO REG-E
INR M ;DBL=DBL+1
MVI D,0 ;HIGH ORDER ZERO FOR DOUBLE ADD
LXI H,DBUFF
DAD D ;DBUFF+DBL TO H,L
POP PSW ;RESTORE DATA BYTE
MOV M,A ;INTO DATA BUFFER
POP D
DHRET: POP B ;ENVIRONMENT RESTORED
RET
;
WRC: ;WRITE CHARACTER WITH CHECK SUM IN D
PUSH PSW
RRC
RRC
RRC
RRC
ANI 0FH
CALL HEXC ;OUTPUT HEX CHARACTER
POP PSW ;RESTORE BYTE
PUSH PSW ;SAVE A VERSION
ANI 0FH
CALL HEXC ;WRITE LOW NIBBLE
POP PSW ;RESTORE BYTE
ADD D ;COMPUTE CHECKSUM
MOV D,A ;SAVE CS
RET
;
HEXC: ;WRITE CHARACTER
ADI 90H
DAA
ACI 40H
DAA
JMP PNB ;PUT BYTE
;
WHEX: ;WRITE CURRENT HEX BUFFER
MVI A,':' ;RECORD HEADER
CALL PNB ;PUT BYTE
LXI H,DBL ;RECORD LENGTH ADDRESS
MOV E,M ;LENGTH TO REG-E
XRA A ;ZERO TO REG-A
MOV D,A ;CLEAR CHECKSUM
MOV M,A ;LENGTH IS ZEROED FOR NEXT WRITE
LHLD BPC ;BASE ADDRESS FOR RECORD
MOV A,E ;LENGTH TO A
CALL WRC ;WRITE HEX VALUE
MOV A,H ;HIGH ORDER BASE ADDR
CALL WRC ;WRITE HO BYTE
MOV A,L ;LOW ORDER BASE ADDR
CALL WRC ;WRITE LO BYTE
XRA A ;ZERO TO A
CALL WRC ;WRITE RECORD TYPE 00
MOV A,E ;CHECK FOR LENGTH 0
ORA A
JZ WHEX1
;
; NON - ZERO, WRITE DATA BYTES
LXI H,DBUFF
WHEX0: MOV A,M ;GET BYTE
INX H
CALL WRC ;WRITE DATA BYTE
DCR E ;END OF BUFFER?
JNZ WHEX0
;
; END OF DATA BYTES, WRITE CHECK SUM
WHEX1: XRA A
SUB D ;COMPUTE CHECKSUM
CALL WRC
;
; SEND CRLF AT END OF RECORD
MVI A,CR
CALL PNB
MVI A,LF
CALL PNB
RET
;
;
;
ENDMOD EQU ($ AND 0FFE0H)+20H
END


405
CPM OPERATING SYSTEMS/CPM 2.X/CPM 2.0/as2scan.asm Normal file
View File

@@ -0,0 +1,405 @@
TITLE 'ASM SCANNER MODULE'
ORG 1100H
JMP ENDMOD ;END OF THIS MODULE
JMP INITS ;INITIALIZE THE SCANNER
JMP SCAN ;CALL THE SCANNER
;
;
; ENTRY POINTS IN I/O MODULE
IOMOD EQU 200H
GNCF EQU IOMOD+6H
WOBUFF EQU IOMOD+15H
PERR EQU IOMOD+18H
;
LASTC: DS 1 ;LAST CHAR SCANNED
NEXTC: DS 1 ;LOOK AHEAD CHAR
STYPE: DS 1 ;RADIX INDICATOR
;
; COMMON EQUATES
PBMAX EQU 120 ;MAX PRINT SIZE
PBUFF EQU 10CH ;PRINT BUFFER
PBP EQU PBUFF+PBMAX ;PRINT BUFFER POINTER
;
TOKEN EQU PBP+1 ;CURRENT TOKEN UDER SCAN
VALUE EQU TOKEN+1 ;VALUE OF NUMBER IN BINARY
ACCLEN EQU VALUE+2 ;ACCUMULATOR LENGTH
ACMAX EQU 64 ;MAX ACCUMULATOR LENGTH
ACCUM EQU ACCLEN+1
;
EVALUE EQU ACCUM+ACMAX ;VALUE FROM EXPRESSION ANALYSIS
;
SYTOP EQU EVALUE+2 ;CURRENT SYMBOL TOP
SYMAX EQU SYTOP+2 ;MAX ADDRESS+1
;
PASS EQU SYMAX+2 ;CURRENT PASS NUMBER
FPC EQU PASS+1 ;FILL ADDRESS FOR NEXT HEX BYTE
ASPC EQU FPC+2 ;ASSEMBLER'S PSEUDO PC
;
; GLOBAL EQUATES
IDEN EQU 1 ;IDENTIFIER
NUMB EQU 2 ;NUMBER
STRNG EQU 3 ;STRING
SPECL EQU 4 ;SPECIAL CHARACTER
;
PLABT EQU 0001B ;PROGRAM LABEL
DLABT EQU 0010B ;DATA LABEL
EQUT EQU 0100B ;EQUATE
SETT EQU 0101B ;SET
MACT EQU 0110B ;MACRO
;
EXTT EQU 1000B ;EXTERNAL
REFT EQU 1011B ;REFER
GLBT EQU 1100B ;GLOBAL
;
BINV EQU 2
OCTV EQU 8
DECV EQU 10
HEXV EQU 16
CR EQU 0DH
LF EQU 0AH
EOF EQU 1AH
TAB EQU 09H ;TAB CHARACTER
;
;
; UTILITY SUBROUTINES
GNC: ;GET NEXT CHARACTER AND ECHO TO PRINT FILE
CALL GNCF
PUSH PSW
CPI CR
JZ GNC0
CPI LF ;IF LF THEN DUMP CURRENT BUFFER
JZ GNC0
;
;NOT A CR OR LF, PLACE INTO BUFFER IF THERE IS ENOUGH ROOM
LDA PBP
CPI PBMAX
JNC GNC0
; ENOUGH ROOM, PLACE INTO BUFFER
MOV E,A
MVI D,0 ;DOUBLE PRECISION PBP IN D,E
INR A
STA PBP ;INCREMENTED PBP IN MEMORY
LXI H,PBUFF
DAD D ;PBUFF(PBP)
POP PSW
MOV M,A ;PBUFF(PBP) = CHAR
RET
GNC0: ;CHAR NOT PLACED INTO BUFFER
POP PSW
RET
;
INITS: ;INITIALIZE THE SCANNER
CALL ZERO
STA NEXTC ;CLEAR NEXT CHARACTER
STA PBP
MVI A,LF ;SET LAST CHAR TO LF
STA LASTC
CALL WOBUFF ;CLEAR BUFFER
MVI A,16 ;START OF PRINT LINE
STA PBP
RET
;
ZERO: XRA A
STA ACCLEN
STA STYPE
RET
;
SAVER: ;STORE THE NEXT CHARACTER INTO THE ACCUMULATOR AND UPDATE ACCLEN
LXI H,ACCLEN
MOV A,M
CPI ACMAX
JC SAV1 ;JUMP IF NOT UP TO LAST POSITION
MVI M,0
CALL ERRO
SAV1: MOV E,M ;D,E WILL HOLD INDEX
MVI D,0
INR M ;ACCLEN INCREMENTED
INX H ;ADDRESS ACCUMULATOR
DAD D ;ADD INDEX TO ACCUMULATOR
LDA NEXTC ;GET CHARACTER
MOV M,A ;INTO ACCUMULATOR
RET
;
TDOLL: ;TEST FOR DOLLAR SIGN, ASSUMING H,L ADDRESS NEXTC
MOV A,M
CPI '$'
RNZ
XRA A ;TO GET A ZERO
MOV M,A ;CLEARS NEXTC
RET ;WITH ZERO FLAG SET
;
NUMERIC: ;CHECK NEXTC FOR NUMERIC, RETURN ZERO FLAG IF NOT NUMERIC
LDA NEXTC
SUI '0'
CPI 10
; CARRY RESET IF NUMERIC
RAL
ANI 1B ;ZERO IF NOT NUMERIC
RET
;
HEX: ;RETURN ZERO FLAG IF NEXTC IS NOT HEXADECIMAL
CALL NUMERIC
RNZ ;RETURNS IF 0-9
LDA NEXTC
SUI 'A'
CPI 6
; CARRY SET IF OUT OF RANGE
RAL
ANI 1B
RET
;
LETTER: ;RETURN ZERO FLAG IF NEXTC IS NOT A LETTER
LDA NEXTC
SUI 'A'
CPI 26
RAL
ANI 1B
RET
;
ALNUM: ;RETURN ZERO FLAG IF NOT ALPHANUMERIC
CALL LETTER
RNZ
CALL NUMERIC
RET
;
TRANS: ;TRANSLATE TO UPPER CASE
LDA NEXTC
CPI 'A' OR 1100000B ;LOWER CASE A
RC ;CARRY IF LESS THAN LOWER A
CPI ('Z' OR 1100000B)+1 ;LOWER CASE Z
RNC ;NO CARRY IF GREATER THAN LOWER Z
ANI 1011111B ;CONVERT TO UPPER CASE
STA NEXTC
RET
;
GNCN: ;GET CHARACTER AND STORE TO NEXTC
CALL GNC
STA NEXTC
CALL TRANS ;TRANSLATE TO UPPER CASE
RET
;
EOLT: ;END OF LINE TEST FOR COMMENT SCAN
CPI CR
RZ
CPI EOF
RZ
CPI '!'
RET
;
SCAN: ;FIND NEXT TOKEN IN INPUT STREAM
XRA A
STA TOKEN
CALL ZERO
;
; DEBLANK
DEBL: LDA NEXTC
CPI TAB ;TAB CHARACTER TREATED AS BLANK OUTSIDE STRING
JZ DEB0
CPI ';' ;MAY BE A COMMENT
JZ DEB1 ;DEBLANK THROUGH COMMENT
CPI '*' ;PROCESSOR TECH COMMENT
JNZ DEB2 ;NOT *
LDA LASTC
CPI LF ;LAST LINE FEED?
JNZ DEB2 ;NOT LF*
; COMMENT FOUND, REMOVE IT
DEB1: CALL GNCN
CALL EOLT ;CR, EOF, OR !
JZ FINDL ;HANDLE END OF LINE
JMP DEB1 ;OTHERWISE CONTINUE SCAN
DEB2: ORI ' ' ;MAY BE ZERO
CPI ' '
JNZ FINDL
DEB0: CALL GNCN ;GET NEXT AND STORE TO NEXTC
JMP DEBL
;
; LINE DEBLANKED, FIND TOKEN TYPE
FINDL: ;LOOK FOR LETTER, DECIMAL DIGIT, OR STRING QUOTE
CALL LETTER
JZ FIND0
MVI A,IDEN
JMP STOKEN
;
FIND0: CALL NUMERIC
JZ FIND1
MVI A,NUMB
JMP STOKEN
;
FIND1: LDA NEXTC
CPI ''''
JNZ FIND2
XRA A
STA NEXTC ;DON'T STORE THE QUOTE
MVI A,STRNG
JMP STOKEN
;
FIND2: ;ASSUME IT IS A SPECIAL CHARACTER
CPI LF ;IF LF THEN DUMP THE BUFFER
JNZ FIND3
; LF FOUND
LDA PASS
ORA A
CNZ WOBUFF
LXI H,PBUFF ;CLEAR ERROR CHAR ON BOTH PASSES
MVI M,' '
MVI A,16
STA PBP ;START NEW LINE
FIND3: MVI A,SPECL
;
STOKEN: STA TOKEN
;
;
; LOOP WHILE CURRENT ITEM IS ACCUMULATING
SCTOK: LDA NEXTC
STA LASTC ;SAVE LAST CHARACTER
ORA A
CNZ SAVER ;STORE CHARACTER INTO ACCUM IF NOT ZERO
CALL GNCN ;GET NEXT TO NEXTC
LDA TOKEN
CPI SPECL
RZ ;RETURN IF SPECIAL CHARACTER
CPI STRNG
CNZ TRANS ;TRANSLATE TO UPPER CASE IF NOT IN STRING
LXI H,NEXTC
LDA TOKEN
;
CPI IDEN
JNZ SCT2
;
; ACCUMULATING AN IDENTIFIER
CALL TDOLL ;$?
JZ SCTOK ;IF SO, SKIP IT
CALL ALNUM ;ALPHA NUMERIC?
RZ ;RETURN IF END
; NOT END OF THE IDENTIFIER
JMP SCTOK
;
SCT2: ;NOT SPECIAL OR IDENT, CHECK NUMBER
CPI NUMB
JNZ SCT3
;
; ACCUMULATING A NUMBER, CHECK FOR $
CALL TDOLL
JZ SCTOK ;SKIP IF FOUND
CALL HEX ;HEX CHARACTER?
JNZ SCTOK ;STORE IT IF FOUND
; END OF NUMBER, LOOK FOR RADIX INDICATOR
;
LDA NEXTC
CPI 'O' ;OCTAL INDICATOR
JZ NOCT
CPI 'Q' ;OCTAL INDICATOR
JNZ NUM2
;
NOCT: ;OCTAL
MVI A,OCTV
JMP SSTYP
;
NUM2: CPI 'H'
JNZ NUM3
MVI A,HEXV
SSTYP: STA STYPE
XRA A
STA NEXTC ;CLEARS THE LOOKAHEAD CHARACTER
JMP NCON
;
; RADIX MUST COME FROM ACCUM
NUM3: LDA LASTC
CPI 'B'
JNZ NUM4
MVI A,BINV
JMP SSTY1
;
NUM4: CPI 'D'
MVI A,DECV
JNZ SSTY2
SSTY1: LXI H,ACCLEN
DCR M ;ACCLEN DECREMENTED TO REMOVE RADIX INDICATOR
SSTY2: STA STYPE
;
NCON: ;NUMERIC CONVERSION OCCURS HERE
LXI H,0
SHLD VALUE ;VALUE ACCUMULATES BINARY EQUIVALENT
LXI H,ACCLEN
MOV C,M ;C=ACCLEN
INX H ;ADDRESSES ACCUM
CLOP: ;NEXT DIGIT IS PROCESSED HERE
MOV A,M
INX H ;READY FOR NEXT LOOP
CPI 'A'
JNC CLOP1 ;NOT HEX A-F
SUI '0' ;NORMALIZE
JMP CLOP2
;
CLOP1: ;HEX A-F
SUI 'A'-10
CLOP2: ;CHECK SIZE AGAINST RADIX
PUSH H ;SAVE ACCUM ADDR
PUSH B ;SAVE CURRENT POSITION
MOV C,A
LXI H,STYPE
CMP M
CNC ERRV ;VALUE ERROR IF DIGIT>=RADIX
MVI B,0 ;DOUBLE PRECISION DIGIT
MOV A,M ;RADIX TO ACCUMULATOR
LHLD VALUE
XCHG ;VALUE TO D,E - ACCUMULATE RESULT IN H,L
LXI H,0 ;ZERO ACCUMULATOR
CLOP3: ;LOOP UNTIL RADIX GOES TO ZERO
ORA A
JZ CLOP4
RAR ;TEST LSB
JNC TTWO ;SKIP SUMMING OPERATION IF LSB=0
DAD D ;ADD IN VALUE
TTWO: ;MULTIPLY VALUE * 2 FOR SHL OPERATION
XCHG
DAD H
XCHG
JMP CLOP3
;
;
CLOP4: ;END OF NUMBER CONVERSION
DAD B ;DIGIT ADDED IN
SHLD VALUE
POP B
POP H
DCR C ;MORE DIGITS?
JNZ CLOP
RET ;DONE WITH THE NUMBER
;
SCT3: ;MUST BE A STRING
LDA NEXTC
CPI CR ;END OF LINE?
JZ ERRO ;AND RETURN
CPI ''''
JNZ SCTOK
CALL GNCN
CPI ''''
RNZ ;RETURN IF SINGLE QUOTE ENCOUNTERED
JMP SCTOK ;OTHERWISE TREAT AS ONE QUOTE
;
; END OF SCANNER
;
; ERROR MESSAGE ROUTINES
ERRV: ;'V' VALUE ERROR
PUSH PSW
MVI A,'V'
JMP ERR
;
ERRO: ;'O' OVERFLOW ERROR
PUSH PSW
MVI A,'O'
JMP ERR
;
ERR: ;PRINT ERROR MESSAGE
PUSH B
PUSH H
CALL PERR
POP H
POP B
POP PSW
RET
;
ENDMOD EQU ($ AND 0FFE0H) + 20H
END


382
CPM OPERATING SYSTEMS/CPM 2.X/CPM 2.0/as3sym.asm Normal file
View File

@@ -0,0 +1,382 @@
TITLE 'ASM SYMBOL TABLE MODULE'
; SYMBOL TABLE MANIPULATION MODULE
;
ORG 1340H
IOMOD EQU 200H ;IO MODULE ENTRY POINT
PCON EQU IOMOD+12H
EOR EQU IOMOD+1EH
;
;
; ENTRY POINTS TO SYMBOL TABLE MODULE
JMP ENDMOD
JMP INISY
JMP LOOKUP
JMP FOUND
JMP ENTER
JMP SETTY
JMP GETTY
JMP SETVAL
JMP GETVAL
;
; COMMON EQUATES
PBMAX EQU 120 ;MAX PRINT SIZE
PBUFF EQU 10CH ;PRINT BUFFER
PBP EQU PBUFF+PBMAX ;PRINT BUFFER POINTER
;
TOKEN EQU PBP+1 ;CURRENT TOKEN UDER SCAN
VALUE EQU TOKEN+1 ;VALUE OF NUMBER IN BINARY
ACCLEN EQU VALUE+2 ;ACCUMULATOR LENGTH
ACMAX EQU 64 ;MAX ACCUMULATOR LENGTH
ACCUM EQU ACCLEN+1
;
EVALUE EQU ACCUM+ACMAX ;VALUE FROM EXPRESSION ANALYSIS
;
SYTOP EQU EVALUE+2 ;CURRENT SYMBOL TOP
SYMAX EQU SYTOP+2 ;MAX ADDRESS+1
;
PASS EQU SYMAX+2 ;CURRENT PASS NUMBER
FPC EQU PASS+1 ;FILL ADDRESS FOR NEXT HEX BYTE
ASPC EQU FPC+2 ;ASSEMBLER'S PSEUDO PC
SYBAS EQU ASPC+2 ;BASE OF SYMBOL TABLE
SYADR EQU SYBAS+2 ;CURRENT SYMBOL BEING ACCESSED
;
; GLOBAL EQUATES
IDEN EQU 1 ;IDENTIFIER
NUMB EQU 2 ;NUMBER
STRNG EQU 3 ;STRING
SPECL EQU 4 ;SPECIAL CHARACTER
;
PLABT EQU 0001B ;PROGRAM LABEL
DLABT EQU 0010B ;DATA LABEL
EQUT EQU 0100B ;EQUATE
SETT EQU 0101B ;SET
MACT EQU 0110B ;MACRO
;
EXTT EQU 1000B ;EXTERNAL
REFT EQU 1011B ;REFER
GLBT EQU 1100B ;GLOBAL
;
;
CR EQU 0DH
;
; DATA AREAS
; SYMBOL TABLE BEGINS AT THE END OF THIS MODULE
FIXD EQU 5 ;5 BYTES OVERHEAD WITH EACH SYMBOL ENTRY
; 2BY COLLISION, 1BY TYPE/LEN, 2BY VALUE
HSIZE EQU 128 ;HASH TABLE SIZE
HMASK EQU HSIZE-1 ;HASH MASK FOR CODING
HASHT: DS HSIZE*2 ;HASH TABLE
HASHC: DS 1 ;HASH CODE AFTER CALL ON LOOKUP
;
; SYMBOL TABLE ENTRY FORMAT IS
; -----------------
; : HIGH VAL BYTE :
; -----------------
; : LOW VAL BYTE :
; -----------------
; : CHARACTER N :
; -----------------
; : ... :
; -----------------
; : CHARACTER 1 :
; -----------------
; : TYPE : LENG :
; -----------------
; : HIGH COLLISION:
; -----------------
; SYADR= : LOW COLLISION :
; -----------------
;
; WHERE THE LOW/HIGH COLLISION FIELD ADDRESSES ANOTHER ENTRY WITH
; THE SAME HASH CODE (OR ZERO IF THE END OF CHAIN), TYPE DESCRIBES
; THE ENTRY TYPE (GIVEN BELOW), LENG IS THE NUMBER OF CHARACTERS IN
; THE SYMBOL PRINTNAME -1 (I.E., LENG=0 IS A SINGLE CHARACTER PRINT-
; NAME, WHILE LENG=15 INDICATES A 16 CHARACTER NAME). CHARACTER 1
; THROUGH N GIVE THE PRINTNAME CHARACTERS IN ASCII UPPER CASE (ALL
; LOWER CASE NAMES ARE TRANSLATED ON INPUT), AND THE LOW/HIGH VALUE
; GIVE THE PARTICULAR ADDRESS OR CONSTANT VALUE ASSOCIATED WITH THE
; NAME. THE REPRESENTATION OF MACROS DIFFERS IN THE FIELDS WHICH
; FOLLOW THE VALUE FIELD (MACROS ARE NOT CURRENTLY IMPLEMENTED).
;
; THE TYPE FIELD CONSISTS OF FOUR BITS WHICH ARE ASSIGNED AS
; FOLLOWS:
;
; 0000 UNDEFINED SYMBOL
; 0001 LOCAL LABELLED PROGRAM
; 0010 LOCAL LABELLED DATA
; 0011 (UNUSED)
; 0100 EQUATE
; 0101 SET
; 0110 MACRO
; 0111 (UNUSED)
;
; 1000 (UNUSED)
; 1001 EXTERN LABELLED PROGRAM
; 1010 EXTERN LABELLED DATA
; 1011 REFERENCE TO MODULE
; 1100 (UNUSED)
; 1101 GLOBAL UNDEFINED SYMBOL
; 1110 GLOBAL LABELLED PROGRAM
; 1111 (UNUSED)
;
; TYPE DEFINITIONS
;
PLABT EQU 0001B ;PROGRAM LABEL
DLABT EQU 0010B ;DATA LABEL
EQUT EQU 0100B ;EQUATE
SETT EQU 0101B ;SET
MACT EQU 0110B ;MACRO
;
EXTT EQU 1000B ;EXTERNAL ATTRIBUTE
REFT EQU 1011B ;REFER
GLBT EQU 1100B ;GLOBAL ATTRIBUTE
;
;
INISY: ;INITIALIZE THE SYMBOL TABLE
LXI H,HASHT ;ZERO THE HASH TABLE
MVI B,HSIZE
XRA A ;CLEAR ACCUM
INI0:
MOV M,A
INX H
MOV M,A ;CLEAR DOUBLE WORD
INX H
DCR B
JNZ INI0
;
; SET SYMBOL TABLE POINTERS
LXI H,0
SHLD SYADR
;
RET
;
CHASH: ;COMPUTE HASH CODE FOR CURRENT ACCUMULATOR
LXI H,ACCLEN
MOV B,M ;GET ACCUM LENGTH
XRA A ;CLEAR ACCUMULATOR
CH0: INX H ;MOVE TO FIRST/NEXT CHARACTER POSITION
ADD M ;ADD WITH OVERFLOW
DCR B
JNZ CH0
ANI HMASK ;MASK BITS FOR MODULO HZISE
STA HASHC ;FILL HASHC WITH RESULT
RET
;
SETLN: ;SET THE LENGTH FIELD OF THE CURRENT SYMBOL
MOV B,A ;SAVE LENGTH IN B
LHLD SYADR
INX H
INX H
MOV A,M ;GET TYPE/LENGTH FIELD
ANI 0F0H ;MASK OUT TYPE FIELD
ORA B ;MASK IN LENGTH
MOV M,A
RET
;
GETLN: ;GET THE LENGTH FIELD TO REG-A
LHLD SYADR
INX H
INX H
MOV A,M
ANI 0FH
INR A ;LENGTH IS STORED AS VALUE - 1
RET
;
FOUND: ;FOUND RETURNS TRUE IF SYADR IS NOT ZERO (TRUE IS NZ FLAG HERE)
LHLD SYADR
MOV A,L
ORA H
RET
;
LOOKUP: ;LOOK FOR SYMBOL IN ACCUMULATOR
CALL CHASH ;COMPUTE HASH CODE
; NORMALIZE IDENTIFIER TO 16 CHARACTERS
LXI H,ACCLEN
MOV A,M
CPI 17
JC LENOK
MVI M,16
LENOK:
; LOOK FOR SYMBOL THROUGH HASH TABLE
LXI H,HASHC
MOV E,M
MVI D,0 ;DOUBLE HASH CODE IN D,E
LXI H,HASHT ;BASE OF HASH TABLE
DAD D
DAD D ;HASHT(HASHC)
MOV E,M ;LOW ORDER ADDRESS
INX H
MOV H,M
MOV L,E ;HEADER TO LIST OF SYMBOLS IS IN H,L
LOOK0: SHLD SYADR
CALL FOUND
RZ ;RETURN IF SYADR BECOMES ZERO
;
; OTHERWISE EXAMINE CHARACTER STRING FOR MATCH
CALL GETLN ;GET LENGTH TO REG-A
LXI H,ACCLEN
CMP M
JNZ LCOMP
;
; LENGTH MATCH, TRY TO MATCH CHARACTERS
MOV B,A ;STRING LENGTH IN B
INX H ;HL ADDRESSES ACCUM
XCHG ;TO D,E
LHLD SYADR
INX H
INX H
INX H ;ADDRESSES CHARACTERS
LOOK1: LDAX D ;NEXT CHARACTER FROM ACCUM
CMP M ;NEXT CHARACTER IN SYMBOL TABLE
JNZ LCOMP
; CHARACTER MATCHED, INCREMENT TO NEXT
INX D
INX H
DCR B
JNZ LOOK1
;
; COMPLETE MATCH AT CURRENT SYMBOL, SYADR IS SET
RET
;
LCOMP: ;NOT FOUND, MOVE SYADR DOWN ONE COLLISION ADDRESS
LHLD SYADR
MOV E,M
INX H
MOV D,M ;COLLISION ADDRESS IN D,E
XCHG
JMP LOOK0
;
;
ENTER: ;ENTER SYMBOL IN ACCUMULATOR
; ENSURE THERE IS ENOUGH SPACE IN THE TABLE
LXI H,ACCLEN
MOV E,M
MVI D,0 ;DOUBLE PRECISION ACCLEN IN D,E
LHLD SYTOP
SHLD SYADR ;NEXT SYMBOL LOCATION
DAD D ;SYTOP+ACCLEN
LXI D,FIXD ;FIXED DATA/SYMBOL
DAD D ;HL HAS NEXT TABLE LOCATION FOR SYMBOL
XCHG ;NEW SYTOP IN D,E
LHLD SYMAX ;MAXIMUM SYMTOP VALUE
MOV A,E
SUB L ;COMPUTE 16-BIT DIFFERENCE
MOV A,D
SBB H
XCHG ;NEW SYTOP IN H,L
JNC OVERER ;OVERFLOW IN TABLE
;
; OTHERWISE NO ERROR
SHLD SYTOP ;SET NEW TABLE TOP
LHLD SYADR ;SET COLLISION FIELD
XCHG ;CURRENT SYMBOL ADDRESS TO D,E
LXI H,HASHC ;HASH CODE FOR CURRENT SYMBOL TO H,L
MOV C,M ;LOW BYTE
MVI B,0 ;DOUBLE PRECISION VALUE IN B,C
LXI H,HASHT ;BASE OF HASH TABLE
DAD B
DAD B ;HASHT(HASHC) IN H,L
; D,E ADDRESSES CURRENT SYMBOL - CHANGE LINKS
MOV C,M ;LOW ORDER OLD HEADER
INX H
MOV B,M ;HIGH ORDER OLD HEADER
MOV M,D ;HIGH ORDER NEW HEADER TO HASH TABLE
DCX H
MOV M,E ;LOW ORDER NEW HEADER TO HASH TABLE
XCHG ;H,L HOLDS SYMBOL TABLE ADDRESS
MOV M,C ;LOW ORDER OLD HEADER TO COLLISION FIELD
INX H
MOV M,B ;HIGH ORDER OLD HEADER TO COLLISION FIELD
;
; HASH CHAIN NOW REPAIRED FOR THIS ENTRY, COPY THE PRINTNAME
LXI D,ACCLEN
LDAX D ;GET SYMBOL LENGTH
CPI 17 ;LARGER THAN 16 SYMBOLS?
JC ENT1
MVI A,16 ;TRUNCATE TO 16 CHARACTERS
; COPY LENGTH FIELD, FOLLOWED BY PRINTNAME CHARACTERS
ENT1: MOV B,A ;COPY LENGTH TO B
DCR A ;1-16 CHANGED TO 0-15
INX H ;FOLLOWING COLLISION FIELD
MOV M,A ;STORE LENGTH WITH UNDEFINED TYPE (0000)
ENT2: INX H
INX D
LDAX D
MOV M,A ;STORE NEXT CHARACTER OF PRINTNAME
DCR B ;LENGTH=LENGTH-1
JNZ ENT2 ;FOR ANOTHER CHARACTER
;
; PRINTNAME COPIED, ZERO THE VALUE FIELD
XRA A ;ZERO A
INX H ;LOW ORDER VALUE
MOV M,A
INX H
MOV M,A ;HIGH ORDER VALUE
RET
;
OVERER: ;OVERFLOW IN SYMBOL TABLE
LXI H,ERRO
CALL PCON
JMP EOR ;END OF EXECUTION
ERRO: DB 'SYMBOL TABLE OVERFLOW',CR
;
SETTY: ;SET CURRENT SYMBOL TYPE TO VALUE IN REG-A
RAL
RAL
RAL
RAL
ANI 0F0H ;TYPE MOVED TO HIGH ORDER 4-BITS
MOV B,A ;SAVE IT IN B
LHLD SYADR ;BASE OF SYMBOL TO ACCESS
INX H
INX H ;ADDRESS OF TYPE/LENGTH FIELD
MOV A,M ;GET IT AND MASK
ANI 0FH ;LEAVE LENGTH
ORA B ;MASK IN TYPE
MOV M,A ;STORE IT
RET
;
GETTY: ;RETURN THE TYPE OF THE VALUE IN CURRENT SYMBOL
LHLD SYADR
INX H
INX H
MOV A,M
RAR
RAR
RAR
RAR
ANI 0FH ;TYPE MOVED TO LOW 4-BITS OF REG-A
RET
;
VALADR: ;GET VALUE FIELD ADDRESS FOR CURRENT SYMBOL
CALL GETLN ;PRINTNAME LENGTH TO ACCUM
LHLD SYADR ;BASE ADDRESS
MOV E,A
MVI D,0
DAD D ;BASE(LEN)
INX H
INX H ;FOR COLLISION FIELD
INX H ;FOR TYPE/LEN FIELD
RET ;WITH H,L ADDRESSING VALUE FIELD
;
SETVAL: ;SET THE VALUE FIELD OF THE CURRENT SYMBOL
; VALUE IS SENT IN H,L
PUSH H ;SAVE VALUE TO SET
CALL VALADR
POP D ;POP VALUE TO SET, HL HAS ADDRESS TO FILL
MOV M,E
INX H
MOV M,D ;FIELD SET
RET
;
GETVAL: ;GET THE VALUE FIELD OF THE CURRENT SYMBOL TO H,L
CALL VALADR ;ADDRESS OF VALUE FIELD TO H,L
MOV E,M
INX H
MOV D,M
XCHG
RET
;
ENDMOD EQU ($ AND 0FFE0H) + 20H
END


415
CPM OPERATING SYSTEMS/CPM 2.X/CPM 2.0/as4sear.asm Normal file
View File

@@ -0,0 +1,415 @@
TITLE 'ASM TABLE SEARCH MODULE'
ORG 15A0H
JMP ENDMOD ;TO NEXT MODULE
JMP BSEAR
JMP BGET
;
; COMMON EQUATES
PBMAX EQU 120 ;MAX PRINT SIZE
PBUFF EQU 10CH ;PRINT BUFFER
PBP EQU PBUFF+PBMAX ;PRINT BUFFER POINTER
;
TOKEN EQU PBP+1 ;CURRENT TOKEN UDER SCAN
VALUE EQU TOKEN+1 ;VALUE OF NUMBER IN BINARY
ACCLEN EQU VALUE+2 ;ACCUMULATOR LENGTH
ACMAX EQU 64 ;MAX ACCUMULATOR LENGTH
ACCUM EQU ACCLEN+1
;
EVALUE EQU ACCUM+ACMAX ;VALUE FROM EXPRESSION ANALYSIS
;
SYTOP EQU EVALUE+2 ;CURRENT SYMBOL TOP
SYMAX EQU SYTOP+2 ;MAX ADDRESS+1
;
PASS EQU SYMAX+2 ;CURRENT PASS NUMBER
FPC EQU PASS+1 ;FILL ADDRESS FOR NEXT HEX BYTE
ASPC EQU FPC+2 ;ASSEMBLER'S PSEUDO PC
;
; GLOBAL EQUATES
IDEN EQU 1 ;IDENTIFIER
NUMB EQU 2 ;NUMBER
STRNG EQU 3 ;STRING
SPECL EQU 4 ;SPECIAL CHARACTER
;
PLABT EQU 0001B ;PROGRAM LABEL
DLABT EQU 0010B ;DATA LABEL
EQUT EQU 0100B ;EQUATE
SETT EQU 0101B ;SET
MACT EQU 0110B ;MACRO
;
EXTT EQU 1000B ;EXTERNAL
REFT EQU 1011B ;REFER
GLBT EQU 1100B ;GLOBAL
;
;
CR EQU 0DH ;CARRIAGE RETURN
;
;
; TABLE DEFINITIONS
;
; TYPES
XBASE EQU 0 ;START OF OPERATORS
; O1 THROUGH O15 DENOTE OPERATIONS
RT EQU 16
PT EQU RT+1 ;RT IS REGISTER TYPE, PT IS PSEUDO OPERATION
OBASE EQU PT+1
O1 EQU OBASE+1 ;SIMPLE
O2 EQU OBASE+2 ;LXI
O3 EQU OBASE+3 ;DAD
O4 EQU OBASE+4 ;PUSH/POP
O5 EQU OBASE+5 ;JMP/CALL
O6 EQU OBASE+6 ;MOV
O7 EQU OBASE+7 ;MVI
O8 EQU OBASE+8 ;ACC IMMEDIATE
O9 EQU OBASE+9 ;LDAX/STAX
O10 EQU OBASE+10 ;LHLD/SHLD/LDA/STA
O11 EQU OBASE+11 ;ACCUM REGISTER
O12 EQU OBASE+12 ;INC/DEC
O13 EQU OBASE+13 ;INX/DCX
O14 EQU OBASE+14 ;RST
O15 EQU OBASE+15 ;IN/OUT
;
; X1 THROUGH X15 DENOTE OPERATORS
X1 EQU XBASE ;*
X2 EQU XBASE+1 ;/
X3 EQU XBASE+2 ;MOD
X4 EQU XBASE+3 ;SHL
X5 EQU XBASE+4 ;SHR
X6 EQU XBASE+5 ;+
X7 EQU XBASE+6 ;-
X8 EQU XBASE+7 ;UNARY -
X9 EQU XBASE+8 ;NOT
X10 EQU XBASE+9 ;AND
X11 EQU XBASE+10;OR
X12 EQU XBASE+11;XOR
X13 EQU XBASE+12;(
X14 EQU XBASE+13;)
X15 EQU XBASE+14;,
X16 EQU XBASE+15;CR
;
;
;
;
; RESERVED WORD TABLES
;
; BASE ADDRESS VECTOR FOR CHARACTERS
CINX: DW CHAR1 ;LENGTH 1 BASE
DW CHAR2 ;LENGTH 2 BASE
DW CHAR3 ;LENGTH 3 BASE
DW CHAR4 ;LENGTH 4 BASE
DW CHAR5 ;LENGTH 5 BASE
DW CHAR6 ;LENGTH 6 BASE
;
CMAX EQU ($-CINX)/2-1 ;LARGEST STRING TO MATCH
;
CLEN: ;LENGTH VECTOR GIVES THE NUMBER OF ITEMS IN EACH TABLE
DB CHAR2-CHAR1
DB (CHAR3-CHAR2)/2
DB (CHAR4-CHAR3)/3
DB (CHAR5-CHAR4)/4
DB (CHAR6-CHAR5)/5
;
TVINX: ;TABLE OF TYPE,VALUE PAIRS FOR EACH RESERVED SYMBOL
DW TV1
DW TV2
DW TV3
DW TV4
DW TV5
;
; CHARACTER VECTORS FOR 1,2,3,4, AND 5 CHARACTER NAMES
CHAR1: DB CR,'()*'
DB '+'
DB ',-/A'
DB 'BCDE'
DB 'HLM'
;
CHAR2: DB 'DBDIDSDW'
DB 'EIIFINOR'
DB 'SP'
;
CHAR3: DB 'ACIADCADDADI'
DB 'ANAANDANICMA'
DB 'CMCCMPCPIDAA'
DB 'DADDCRDCXEND'
DB 'EQUHLTINRINX'
DB 'JMPLDALXIMOD'
DB 'MOVMVINOPNOT'
DB 'ORAORGORIOUT'
DB 'POPPSWRALRAR'
DB 'RETRLCRRCRST'
DB 'SBBSBISETSHL'
DB 'SHRSTASTCSUB'
DB 'SUIXORXRAXRI'
;
CHAR4: DB 'CALLENDMLDAXLHLDPCHL'
DB 'PUSHSHLDSPHLSTAX'
DB 'XCHGXTHL'
;
CHAR5: DB 'ENDIFMACROTITLE'
;
CHAR6: ;END OF CHARACTER VECTOR
;
TV1: ;TYPE,VALUE PAIRS FOR CHAR1 VECTOR
DB X16,10, X13,20 ;CR (
DB X14,30, X1,80 ;) *
DB X6,70 ;+
DB X15,10, X7,70 ;, -
DB X2,80, RT,7 ;/ A
DB RT,0, RT,1 ;B C
DB RT,2, RT,3 ;D E
DB RT,4, RT,5 ;H L
DB RT,6 ;M
;
TV2: ;TYPE,VALUE PAIRS FOR CHAR2 VECTOR
DB PT,1, O1,0F3H ;DB DI
DB PT,2, PT,3 ;DS DW
DB O1,0FBH, PT,8 ;EI IF
DB O15,0DBH, X11,40 ;IN OR
DB RT,6 ;SP
;
;
TV3: ;TYPE,VALUE PAIRS FOR CHAR3 VECTOR
DB O8,0CEH, O11,88H ;ACI ADC
DB O11,80H, O8,0C6H ;ADD ADI
DB O11,0A0H, X10,50 ;ANA AND
DB O8,0E6H, O1,2FH ;ANI CMA
DB O1,3FH, O11,0B8H ;CMC CMP
DB O8,0FEH, O1,27H ;CPI DAA
DB O3,09H, O12,05H ;DAD DCR
DB O13,0BH, PT,4 ;DCX END
DB PT,7, O1,76H ;EQU HLT
DB O12,04H, O13,03H ;INR INX
DB O5,0C3H, O10,3AH ;JMP LDA
DB O2,01H, X3,80 ;LXI MOD
DB O6,40H, O7,06H ;MOV MVI
DB O1,00H, X9,60 ;NOP NOT
DB O11,0B0H, PT,10 ;ORA ORG
DB O8,0F6H, O15,0D3H ;ORI OUT
DB O4,0C1H, RT,6 ;POP PSW
DB O1,17H, O1,1FH ;RAL RAR
DB O1,0C9H, O1,07H ;RET RLC
DB O1,0FH, O14,0C7H ;RRC RST
DB O11,098H, O8,0DEH ;SBB SBI
DB PT,11, X4,80 ;SET SHL
DB X5,80, O10,32H ;STA STC
DB O1,37H, O11,90H ;STC SUB
DB O8,0D6H, X12,40 ;SUI XOR
DB O11,0A8H, O8,0EEH ;XRA XRI
;
;
TV4: ;TYPE,VALUE PAIRS FOR CHAR4 VECTOR
DB O5,0CDH ;CALL
DB PT,6, O9,0AH ;ENDM LDAX
DB O10,02AH, O1,0E9H ;LHLD PCHL
DB O4,0C5H, O10,22H ;PUSH SHLD
DB O1,0F9H, O9,02H ;SPHL STAX
DB O1,0EBH, O1,0E3H ;XCHG XTHL
;
TV5: ;TYPE,VALUE PAIRS FOR CHAR5 VECTOR
DB PT,5, PT,9 ;ENDIF MACRO
DB PT,12 ;TITLE
;
SUFTAB: ;TABLE OF SUFFIXES FOR J C AND R OPERATIONS
DB 'NZZ NCC POPEP M '
;
BSEAR: ;BINARY SEARCH MNEMONIC TABLE
; INPUT: UR = UPPER BOUND OF TABLE (I.E., TABLE LENGTH-1)
; SR = SIZE OF EACH TABLE ELEMENT
; H,L ADDRESS BASE OF TABLE TO SEARCH
; OUTPUT: ZERO FLAG INDICATES MATCH WAS FOUND, IN WHICH CASE
; THE ACCUMULATOR CONTAINS AN INDEX TO THE ELEMENT
; NOT ZERO FLAG INDICATES NO MATCH FOUND IN TABLE
;
UR EQU B ;UPPER BOUND REGISTER
LR EQU C ;LOWER BOUND REGISTER
SR EQU D ;SIZE REGISTER
MR EQU E ;MIDDLE POINTER REGISTER
SP1 EQU B ;SIZE PRIME, USED IN COMPUTING MIDDLE POSITON
SP1P EQU C ;ANOTHER COPY OF SIZE PRIME
KR EQU H ;K
;
MVI MR,255 ;MARK M <> OLD M
INR UR ;U=U+1
MVI LR,0 ;L = 0
;
; COMPUTE M' = (U+L)/2
NEXT: XRA A
MOV A,UR ;CY=0, A=U
ADD LR ;(U+L)
RAR ;(U+L)/2
CMP MR ;SAME AS LAST TIME THROUGH?
JZ NMATCH ;JUMP IF = TO NO MATCH
;
; MORE ELEMENTS TO SCAN
MOV MR,A ;NEW MIDDLE VALUE
PUSH H ;SAVE A COPY OF THE BASE ADDRESS
PUSH D ;SAVE S,M
PUSH B ;SAVE U,L
PUSH H ;SAVE ANOTHER COPY OF THE BASE ADDRESS
MOV SP1,SR ;S' = S
MOV SP1P,SP1 ;S'' = S'
MVI SR,0 ;FOR DOUBLE ADD OPERATION BELOW (DOUBLE M)
;
LXI KR,0 ;K=0
SUMK: DAD D ;K = K + M
DCR SP1 ;S' = S' - 1
JNZ SUMK ;DECREMENT IF SP1 <> 0
;
; K IS NOW RELATIVE BYTE POSITION
POP D ;TABLE BASE ADDRESS
DAD D ;H,L CONTAINS ABSOLUTE ADDRESS OF BYTE TO COMPARE
LXI D,ACCUM ;D,E ADDRESS CHARACTERS TO COMPARE
;
COMK: ;COMPARE NEXT CHARACTER
LDAX D ;ACCUM CHARACTER TO REG A
CMP M ;SAME AS TABLE ENTRY?
INX D
INX H ;TO NEXT POSITIONS
JNZ NCOM ;JUMP IF NOT THE SAME
DCR SP1P ;MORE CHARACTERS?
JNZ COMK
;
; COMPLETE MATCH AT M
POP B
POP D ;M RESTORED
POP H
MOV A,MR ;VALUE OF M COPIED IN A
RET ;WITH ZERO FLAG SET
;
NCOM: ;NO MATCH, DETERMINE IF LESS OR GREATER
POP B ;U,L
POP D ;S,M
POP H ;TABLE ADDRESS
JC NCOML
; ACCUM IS HIGHER
MOV LR,MR ;L = M
JMP NEXT
;
NCOML: ;ACCUMULATOR IS LOW
MOV UR,MR ;U = M
JMP NEXT
;
NMATCH: ;NO MATCH
XRA A
INR A ;SETS NOT ZERO FLAG
RET
;
PREFIX: ;J C OR R PREFIX?
LDA ACCUM
LXI B,(0C2H SHL 8) OR O5 ;JNZ OPCODE TO B, TYPE TO C
CPI 'J'
RZ ;RETURN WITH ZERO FLAG SET IF J
MVI B,0C4H ;CNZ OPCODE TO B, TYPE IS IN C
CPI 'C'
RZ
LXI B,(0C0H SHL 8) OR O1 ;RNZ OPCODE
CPI 'R'
RET
;
SUFFIX: ;J R OR C RECOGNIZED, LOOK FOR SUFFIX
LDA ACCLEN
CPI 4 ;CHECK LENGTH
JNC NSUFF ;CARRY IF 0,1,2,3 IN LENGTH
CPI 3
JZ SUF0 ;ASSUME 1 OR 2 IF NO BRANCH
CPI 2
JNZ NSUFF ;RETURNS IF 0 OR 1
LXI H,ACCUM+2
MVI M,' ' ;BLANK-OUT FOR MATCH ATTEMPT
SUF0: ;SEARCH 'TIL END OF TABLE
LXI B,8 ;B=0, C=8 COUNTS TABLE DOWN TO ZERO OR MATCH
LXI D,SUFTAB
NEXTS: ;LOOK AT NEXT SUFFIX
LXI H,ACCUM+1 ;SUFFIX POSITION
LDAX D ;CHARACTER TO ACCUM
CMP M
INX D ;READY FOR NEXT CHARACTER
JNZ NEXT0 ;JMP IF NO MATCH
LDAX D ;GET NEXT CHARACTER
INX H ;READY FOR COMPARE WITH ACCUM
CMP M ;SAME?
RZ ;RETURN WITH ZERO FLAG SET, B IS SUFIX
NEXT0: INX D ;MOVE TO NEXT CHARACTER
INR B ;COUNT SUFFIX UP
DCR C ;COUNT TABLE LENGTH DOWN
JNZ NEXTS
; END OF TABLE, MARK WITH NON ZERO FLAG
INR C
RET
;
NSUFF: ;NOT PROPER SUFFIX - SET NON ZERO FLAG
XRA A
INR A
RET
;
BGET: ;PERFORM BINARY SEARCH, AND EXTRACT TYPE AND VAL FIELDS FOR
; THE ITEM. ZERO FLAG INDICATES MATCH WAS FOUND, WITH TYPE
; IN THE ACCUMULATOR, AND VAL IN REGISTER B. THE SEARCH IS BASED
; UPON THE LENGTH OF THE ACCUMULATOR
LDA ACCLEN ;ITEM LENGTH
MOV C,A ;SAVE A COPY
DCR A ;ACCLEN-1
MOV E,A
MVI D,0 ;DOUBLE ACCLEN-1 TO D,E
PUSH D ;SAVE A COPY FOR LATER
CPI CMAX ;TOO LONG?
JNC NGET ;NOT IN RANGE IF CARRY
LXI H,CLEN ;LENGTH VECTOR
DAD D
MOV UR,M ;FILL UPPER BOUND FROM MEMORY
LXI H,CINX
DAD D
DAD D ;BASE ADDRESS TO H,L
MOV D,M
INX H
MOV H,M
MOV L,D ;NOW IN H,L
MOV SR,C ;FILL THE SIZE REGISTER
CALL BSEAR ;PERFORM THE BINARY SEARCH
JNZ SCASE ;ZERO IF FOUND
POP D ;RESTORE INDEX
LXI H,TVINX
DAD D
DAD D ;ADDRESSING PROPER TV ELEMENT
MOV E,M
INX H
MOV D,M
; D,E IS BASE ADDRESS OF TYPE/VALUE VECTOR, ADD DISPLACEMENT
MOV L,A
MVI H,0
DAD H ;DOUBLED
DAD D ;INDEXED
MOV A,M ;TYPE TO ACC
INX H
MOV B,M ;VALUE TO B
RET ;TYPE IN ACC, VALUE IN B
;
SCASE: ;NAME NOT TOO LONG, BUT NOT FOUND IN TABLES, MAY BE J C OR R
POP D ;RESTORE INDEX
CALL PREFIX
RNZ ;NOT FOUND AS PREFIX J C OR R IF NOT ZERO FLAG
PUSH B ;SAVE VALUE AND TYPE
CALL SUFFIX ;ZERO IF SUFFIX MATCHED
MOV A,B ;READY FOR MASK IF ZERO FLAG
POP B ;RECALL VALUE AND TYPE
RNZ ;RETURN IF NOT ZERO FLAG SET
; MASK IN THE PROPER BITS AND RETURN
ORA A ;CLEAR CARRY
RAL
RAL
RAL
ORA B ;VALUE SET TO JNZ ...
MOV B,A ;REPLACE
MOV A,C ;RETURN WITH TYPE IN REGISTER A
CMP A ;CLEAR THE ZERO FLAG
RET
;
NGET: ;CAN'T FIND THE ENTRY, RETURN WITH ZERO FLAG RESET
POP D ;GET THE ELEMENT BACK
XRA A ;CLEAR
INR A ;ZERO FLAG RESET
RET
;
;
ENDMOD EQU ($ AND 0FFE0H) + 20H ;NEXT MODULE ADDRESS
END


594
CPM OPERATING SYSTEMS/CPM 2.X/CPM 2.0/as5oper.asm Normal file
View File

@@ -0,0 +1,594 @@
TITLE 'ASM OPERAND SCAN MODULE'
; OPERAND SCAN MODULE
ORG 1860H
;
; EXTERNALS
IOMOD EQU 200H ;I/O MODULE
SCMOD EQU 1100H ;SCANNER MODULE
SYMOD EQU 1340H ;SYMBOL TABLE MODULE
BMOD EQU 15A0H ;BINARY SEARCH MODULE
;
;
PERR EQU IOMOD+18H
SCAN EQU SCMOD+6H ;SCANNER ENTRY POINT
CR EQU 0DH ;CARRIAGE RETURN
;
LOOKUP EQU SYMOD+6H ;LOOKUP
FOUND EQU LOOKUP+3 ;FOUND SYMBOL IF ZERO FLAG NOT SET
ENTER EQU FOUND+3 ;ENTER SYMBOL
SETTY EQU ENTER+3 ;SET TYPE FIELD
GETTY EQU SETTY+3 ;SET TYPE FIELD
SETVAL EQU GETTY+3 ;SET VALUE FIELD
GETVAL EQU SETVAL+3 ;GET VALUE FIELD
;
BSEAR EQU BMOD+3 ;BINARY SEARCH ROUTINE
BGET EQU BSEAR+3 ;GET VALUES WITH SEARCH
;
; COMMON EQUATES
PBMAX EQU 120 ;MAX PRINT SIZE
PBUFF EQU 10CH ;PRINT BUFFER
PBP EQU PBUFF+PBMAX ;PRINT BUFFER POINTER
;
TOKEN EQU PBP+1 ;CURRENT TOKEN UDER SCAN
VALUE EQU TOKEN+1 ;VALUE OF NUMBER IN BINARY
ACCLEN EQU VALUE+2 ;ACCUMULATOR LENGTH
ACMAX EQU 64 ;MAX ACCUMULATOR LENGTH
ACCUM EQU ACCLEN+1
;
EVALUE EQU ACCUM+ACMAX ;VALUE FROM EXPRESSION ANALYSIS
;
SYTOP EQU EVALUE+2 ;CURRENT SYMBOL TOP
SYMAX EQU SYTOP+2 ;MAX ADDRESS+1
;
PASS EQU SYMAX+2 ;CURRENT PASS NUMBER
FPC EQU PASS+1 ;FILL ADDRESS FOR NEXT HEX BYTE
ASPC EQU FPC+2 ;ASSEMBLER'S PSEUDO PC
;
; GLOBAL EQUATES
IDEN EQU 1 ;IDENTIFIER
NUMB EQU 2 ;NUMBER
STRNG EQU 3 ;STRING
SPECL EQU 4 ;SPECIAL CHARACTER
;
PLABT EQU 0001B ;PROGRAM LABEL
DLABT EQU 0010B ;DATA LABEL
EQUT EQU 0100B ;EQUATE
SETT EQU 0101B ;SET
MACT EQU 0110B ;MACRO
;
EXTT EQU 1000B ;EXTERNAL
REFT EQU 1011B ;REFER
GLBT EQU 1100B ;GLOBAL
;
;
; TABLE DEFINITIONS
XBASE EQU 0 ;START OF OPERATORS
OPER EQU 15 ;LAST OPERATOR
RT EQU 16
PT EQU RT+1 ;RT IS REGISTER TYPE, PT IS PSEUDO OPERATION
OBASE EQU PT+1
;
PLUS EQU 5
MINUS EQU 6
NOTF EQU 8 ;NOT
LPAR EQU 12
RPAR EQU 13
OSMAX EQU 10
VSMAX EQU 8*2
;
;
; BEGINNING OF MODULE
JMP ENDMOD ;PAST THIS MODULE
JMP OPAND ;SCAN OPERAND FIELD
JMP MULF ;MULTIPLY FUNCTION
JMP DIVE ;DIVIDE FUNCTION
UNARY: DS 1 ;TRUE IF NEXT OPERATOR IS UNARY
OPERV: DS OSMAX ;OPERATOR STACK
HIERV: DS OSMAX ;OPERATOR PRIORITY
VSTACK: DS VSMAX ;VALUE STACK
OSP: DS 1 ;OPERATOR STACK POINTER
VSP: DS 1 ;VALUE STACK POINTER
;
;
;
STKV: ;PLACE CURRENT H,L VALUE AT TOP OF VSTACK
XCHG ;HOLD VALUE IN D,E
LXI H,VSP
MOV A,M
CPI VSMAX
JC STKV0
CALL ERREX ;OVERFLOW IN EXPRESSION
MVI M,0 ;VSP=0
STKV0: MOV A,M ;GET VSP
INR M ;VSP=VSP+1
INR M ;VSP=VSP+2
MOV C,A ;SAVE VSP
MVI B,0 ;DOUBLE VSP
LXI H,VSTACK
DAD B
MOV M,E ;LOW BYTE
INX H
MOV M,D ;HIGH BYTE
RET
;
STKO: ;STACK OPERATOR (REG-A) AND PRIORITY (REG-B)
PUSH PSW ;SAVE IT
LXI H,OSP
MOV A,M
CPI OSMAX
JC STKO1
MVI M,0
CALL ERREX ;OPERATOR STACK OVERFLOW
STKO1: MOV E,M ;GET OSP
MVI D,0
INR M ;OSP=OSP+1
POP PSW ;RECALL OPERATOR
LXI H,OPERV
DAD D ;OPERV(OSP)
MOV M,A ;OPERV(OSP)=OPERATOR
LXI H,HIERV
DAD D
MOV M,B ;HIERV(OSP)=PRIORITY
RET
;
LODV1: ;LOAD TOP ELEMENT FROM VSTACK TO H,L
LXI H,VSP
MOV A,M
ORA A
JNZ LODOK
CALL ERREX ;UNDERFLOW
LXI H,0
RET
;
LODOK: DCR M
DCR M ;VSP=VSP-2
MOV C,M ;LOW BYTE
MVI B,0
LXI H,VSTACK
DAD B ;VSTACK(VSP)
MOV C,M ;GET LOW BYTE
INX H
MOV H,M
MOV L,C
RET
;
LODV2: ;LOAD TOP TWO ELEMENTS DE HOLDS TOP, HL HOLDS TOP-1
CALL LODV1
XCHG
CALL LODV1
RET
;
APPLY: ;APPLY OPERATOR IN REG-A TO TOP OF STACK
MOV L,A
MVI H,0
DAD H ;OPERATOR NUMBER*2
LXI D,OPTAB
DAD D ;INDEXED OPTAB
MOV E,M ;LOW ADDRESS
INX H
MOV H,M ;HIGH ADDRESS
MOV L,E
PCHL ;SET PC AND GO TO SUBROUTINE
;
OPTAB: DW MULOP
DW DIVOP
DW MODOP
DW SHLOP
DW SHROP
DW ADDOP
DW SUBOP
DW NEGOP
DW NOTOP
DW ANDOP
DW OROP
DW XOROP
DW ERREX ;(
;
; SPECIFIC HANDLERS FOLLOW
SHFT: ;SET UP OPERANDS FOR SHIFT L AND R
CALL LODV2
MOV A,D ;ENSURE 0-15
ORA A
JNZ SHERR
MOV A,E
CPI 17
RC ;RETURN IF 0-16 SHIFT
SHERR: CALL ERREX
MVI A,16
RET
;
NEGF: ;COMPUTE 0-H,L TO H,L
XRA A
SUB L
MOV L,A
MVI A,0
SBB H
MOV H,A
RET
;
DIVF: CALL LODV2
DIVE: ;(EXTERNAL ENTRY FROM MAIN PROGRAM)
XCHG ;SWAP D,E WITH H,L FOR DIVIDE FUNCTION
; COMPUTE X/Y WHERE X IS IN D,E AND Y IS IN H,L
; THE VALUE OF X/Y APPEARS IN D,E AND X MOD Y IS IN H,L
;
SHLD DTEMP ;SAVE X IN TEMPORARY
LXI H,BNUM ;STORE BIT COUNT
MVI M,11H
LXI B,0 ;INTIALIZE RESULT
PUSH B
XRA A ;CLEAR FLAGS
DLOOP:
MOV A,E ;GET LOW Y BYTE
RAL
MOV E,A
MOV A,D
RAL
MOV D,A
DCR M ;DECREMENT BIT COUNT
POP H ;RESTORE TEMP RESULT
RZ ;ZERO BIT COUNT MEANS ALL DONE
MVI A,0 ;ADD IN CARRY
ACI 0 ;CARRY
DAD H ;SHIFT TEMP RESULT LEFT ONE BIT
MOV B,H ;COPY HA AND L TO A A ND C
ADD L
LHLD DTEMP ;GET ADDRESS OF X
SUB L ;SUBTRACT FROM TEMPORARY RESULT
MOV C,A
MOV A,B
SBB H
MOV B,A
PUSH B ;SAVE TEMP RESULT IN STACK
JNC DSKIP ;NO BORROW FROM SUBTRACT
DAD B ;ADD X BACK IN
XTHL ;REPLACE TEMP RESULT ON STACK
DSKIP: LXI H,BNUM ;RESTORE H,L
CMC
JMP DLOOP ;REPEAT LOOP STEPS
;
DTEMP: DS 2
BNUM: DS 1
;
MULF: ;MULTIPLY D,E BY H,L AND REPLACE H,L WITH RESULT
MOV B,H
MOV C,L ;COPY OF 1ST VALUE TO B,C FOR SHIFT AND ADD
LXI H,0 ;H,L IS THE ACCUMULATOR
MUL0: XRA A
MOV A,B ;CARRY IS CLEARED
RAR
MOV B,A
MOV A,C
RAR
MOV C,A
JC MUL1 ;SKIP THIS ADD IF LSB IS ZERO
ORA B
RZ ;RETURN WITH H,L
JMP MUL2 ;SKIP ADD
MUL1: DAD D ;ADD CURRENT VALUE OF D
MUL2: XCHG ;READY FOR *2
DAD H
XCHG
JMP MUL0
;
MULOP: ;MULTIPLY D,E BY H,L
CALL LODV2
CALL MULF
JMP ENDOP
;
DIVOP: ;DIVIDE H,L BY D,E
CALL DIVF
XCHG ;RESULT TO H,L
JMP ENDOP
;
MODOP: CALL DIVF
JMP ENDOP
;
SHLOP: CALL SHFT ;CHECK VALUES
SHL0: ORA A ;DONE?
JZ ENDOP
DAD H ;HL=HL*2
DCR A
JMP SHL0
;
SHROP: CALL SHFT
SHR0: ORA A ;DONE?
JZ ENDOP
PUSH PSW ;SAVE CURRENT COUNT
XRA A
MOV A,H
RAR
MOV H,A
MOV A,L
RAR
MOV L,A
POP PSW
DCR A
JMP SHR0
;
ADDOP: CALL LODV2
ADD0: DAD D
JMP ENDOP
;
SUBOP: CALL LODV2
XCHG ;TREAT AS HL+(-DE)
CALL NEGF ;0-HL
JMP ADD0
;
NEGOP: CALL LODV1
NEG0: CALL NEGF ;COMPUTE 0-HL
JMP ENDOP
;
NOTOP: CALL LODV1
INX H ;65536-HL = 65535-(HL+1)
JMP NEG0
;
ANDOP: CALL LODV2
MOV A,D
ANA H
MOV H,A
MOV A,E
ANA L
MOV L,A
JMP ENDOP
;
OROP: CALL LODV2
MOV A,D
ORA H
MOV H,A
MOV A,E
ORA L
MOV L,A
JMP ENDOP
;
XOROP: CALL LODV2
MOV A,D
XRA H
MOV H,A
MOV A,E
XRA L
MOV L,A
;
ENDOP: JMP STKV
;
;
;
ENDEXP: ;RETURNS ZERO FLAG IF SYMBOL IS CR, ;, OR ,
LDA TOKEN
CPI SPECL
RNZ ;NOT END IF NOT SPECIAL
;
LDA ACCUM
CPI CR
RZ
CPI ';'
RZ
CPI ','
RZ
CPI '!'
RET
;
OPAND: ;SCAN THE OPERAND FIELD OF AN INSTRUCTION
; (NOT A DB WITH FIRST TOKEN STRING > 2 OR 0)
XRA A
STA OSP ;ZERO OPERATOR STACK POINTER
STA VSP
DCR A ;255
STA UNARY
LXI H,0
SHLD EVALUE
;
OP0: ;ARRIVE HERE WITH NEXT ITEM ALREADY SCANNED
CALL ENDEXP ;DONE?
JNZ OP1
; EMPTY THE OPERATOR STACK
EMPOP: LXI H,OSP
MOV A,M ;GET THE OSP AND CHECK FOR EMPTY
ORA A
JZ CHKVAL ;JUMP IF EMPTY
DCR M ;POP ELEMENT
MOV E,A ;COPY FOR DOUBLE ADD
DCR E
MVI D,0
LXI H,OPERV
DAD D ;INDEXED - OPERV(OSP)
MOV A,M ;GET OPERATOR
CALL APPLY ;APPLY OPERATOR
JMP EMPOP
;
CHKVAL:
LDA VSP ;MUST HAVE ONE ELEMENT IT THE STACK
CPI 2
CNZ ERREX
LDA PBUFF
CPI ' '
RNZ ;EVALUE REMAINS AT ZERO
LHLD VSTACK ;GET DOUBLE BYTE IN STACK
SHLD EVALUE
RET
;
OP1: ;MORE TO SCAN
LDA PBUFF
CPI ' '
JNZ GETOP
LDA TOKEN
CPI STRNG ;IS THIS A STRING?
JNZ OP3
;
; STRING - CONVERT TO DOUBLE PRECISION
LDA ACCLEN
ORA A
CZ ERREX ;ERROR IF LENGTH=0
CPI 3
CNC ERREX ;ERROR IF LENGTH>2
MVI D,0
LXI H,ACCUM
MOV E,M ;LSBYTE
INX H
DCR A ;A HAS THE LENGTH
JZ OP2 ;ONE OR TWO BYTES
MOV D,M ;FILL HIGH ORDER
OP2: XCHG ;VALUE TO H,L
JMP STNUM ;STORE TO STACK
;
OP3: ;NOT A STRING, CHECK FOR NUMBER
CPI NUMB
JNZ OP4
LHLD VALUE ;NUMERIC VALUE
JMP STNUM
;
OP4: ;NOT STRING OR NUMBER, MUST BE ID OR SPECL
CALL BGET ;BINARY SEARCH, GET ATTRIBUTES
JNZ OP6 ;MATCH?
; YES, MAY BE OPERATOR
CPI OPER+1
JNC OP5
; OPERATOR ENCOUNTERED MS NIBBLE OF B IS PRIORITY NUMBER LS NIBBLE
; IS THE OPERATOR
; ACC HAS THE OPERATOR NUMBER, B HAS PRIORITY
CPI LPAR ;(?
MOV C,A ;SAVE COPY OF OPERATOR NUMBER
LDA UNARY
JNZ OPER1 ;JUMP IF NOT A (
; ( ENCOUNTERED, UNARY MUST BE TRUE
ORA A
CZ ERREX
MVI A,0FFH
STA UNARY ;UNARY IS SET TRUE
MOV A,C ;RECOVER OPERATOR
JMP OPER4 ;CALLS STKO AND SETS UNARY TO TRUE
;
;
OPER1: ;NOT A LEFT PAREN
ORA A
JNZ OPER6 ;MUST BE + OR - SINCE UNARY IS SET
;
; UNARY NOT SET, MUST BE BINARY OPERATOR
OPER2: ;COMPARE HIERARCHY OF TOS
PUSH B ;SAVE PRIORITY AND OPERATOR NUMBER
LDA OSP
ORA A
JZ OPER3 ;NO MORE OPERATORS IN STACK
MOV E,A ;OSP TO E
DCR E ;OSP-1
MVI D,0
LXI H,HIERV
DAD D ;HL ADDRESSES TOP OF OPERATOR STACK
MOV A,M ;PRIORITY OF TOP OPERATOR
CMP B ;CURRENT GREATER?
JC OPER3 ;JUMP IF SO
; APPLY TOP OPERATOR TO VALUE STACK
LXI H,OSP
MOV M,E ;OSP=OSP-1
LXI H,OPERV
DAD D
MOV A,M ;OPERATOR NUMBER TO ACC
CALL APPLY
POP B ;RESTORE OPERATOR NUMBER AND PRIORITY
JMP OPER2 ;FOR ANOTHER TEST
;
OPER3: ;ARRIVE HERE WHEN OPERATOR IS STACKED
; CHECK FOR RIGHT PAREN BALANCE
POP B ;OPERATOR NUMBER IN C, PRIORITY IN B
MOV A,C
CPI RPAR
JNZ OPER4 ;JUMP IF NOT A RIGHT PAREN
;
; RIGHT PAREN FOUND, STACK MUST CONTAIN LEFT PAREN TO DELETE
LXI H,OSP
MOV A,M
ORA A ;ZERO?
JZ LPERR ;PAREN ERROR IF SO
DCR A ;OSP-1
MOV M,A ;STORED TO MEMORY
MOV E,A
MVI D,0
LXI H,OPERV
DAD D
MOV A,M ;TOP OPERATOR IN REG-A
CPI LPAR
JZ NLERR ;JMP IF NO ERROR - PARENS BALANCE
LPERR: CALL ERREX
NLERR: ;ERROR REPORTING COMPLETE
XRA A
JMP OPER5 ;TO CLEAR UNARY FLAG
;
OPER4: ;ORDINARY OPERATOR
CALL STKO
MVI A,0FFH ;TO SET UNARY FLAG
OPER5: STA UNARY
JMP GETOP ;FOR ANOTHER ELEMENT
;
OPER6: ;UNARY SET, MUST BE + OR -
MOV A,C ;RECALL OPERATOR
CPI PLUS
JZ GETOP ;IGNORE UNARY PLUS
CPI MINUS
JNZ CHKNOT
INR A ;CHANGE TO UNARY MINUS
MOV C,A
JMP OPER2
CHKNOT: ;UNARY NOT SYMBOL?
CPI NOTF
CNZ ERREX
JMP OPER2
;
;
OP5: ;ELEMENT FOUND IN TABLE, NOT AN OPERATOR
CPI PT ;PSEUDO OPERATOR?
CZ ERREX ;ERROR IF SO
MOV L,B ;GET LOW VALUE TO L
MVI H,0 ;ZERO HIGH ORDER BYTE
JMP STNUM ;STORE IT
;
OP6: ;NOT FOUND IN TABLE SCAN, $?
LDA TOKEN
CPI SPECL
JNZ OP7
LDA ACCUM
CPI '$'
JZ CURPC ;USE CURRENT PC
CALL ERREX
LXI H,0
JMP STNUM
CURPC: LHLD ASPC ;GET CURRENT PC
JMP STNUM
;
OP7: ;NOT $, LOOK IT UP
CALL LOOKUP
CALL FOUND
JNZ FIDENT
; NOT FOUND IN SYMBOL TABLE, ENTER IF PASS 1
MVI A,'P'
CALL PERR
CALL ENTER ;ENTER SYMBOL WITH ZERO TYPE FIELD
JMP FIDE0
FIDENT: CALL GETTY ;TYPE TO H,L
ANI 111B
MVI A,'U'
CZ PERR
;
FIDE0:
CALL GETVAL ;VALUE TO H,L
;
STNUM: ;STORE H,L TO VALUE STACK
LDA UNARY
ORA A ;UNARY OPERATION SET
CZ ERREX ;OPERAND ENCOUNTERED WITH UNARY OFF
XRA A
STA UNARY ;SET TO OFF
CALL STKV ;STACK THE VALUE
;
GETOP: CALL SCAN
JMP OP0
;
ERREX: ;PUT 'E' ERROR IN OUTPUT BUFFER
PUSH H
MVI A,'E'
CALL PERR
POP H
RET
;
ENDMOD EQU ($ AND 0FFE0H) + 20H ;NEXT HALF PAGE
END


889
CPM OPERATING SYSTEMS/CPM 2.X/CPM 2.0/as6main.asm Normal file
View File

@@ -0,0 +1,889 @@
TITLE 'ASM MAIN MODULE'
; CP/M RESIDENT ASSEMBLER MAIN PROGRAM
;
; COPYRIGHT (C) 1976, 1977, 1978
; DIGITAL RESEARCH
; BOX 579, PACIFIC GROVE
; CALIFORNIA, 93950
;
;
ORG 1BA0H
; MODULE ENTRY POINTS
IOMOD EQU 200H ;IO MODULE
SCMOD EQU 1100H ;SCANNER MODULE
SYMOD EQU 1340H ;SYMBOL TABLE MODULE
BMOD EQU 15A0H ;BINARY SEARCH MODULE
OPMOD EQU 1860H ;OPERAND SCAN MODULE
;
SETUP EQU IOMOD+3H ;FILE SETUP FOR EACH PASS
PCON EQU IOMOD+12H ;WRITE CONSOLE BUFFER TO CR
WOBUFF EQU IOMOD+15H ;WRITE PRINT BUFFER AND REINITIALIZE
PERR EQU IOMOD+18H ;WRITE ERROR CHARACTER TO PRINT BUFFER
DHEX EQU IOMOD+1BH ;SEND HEX CHARACTER TO MACHINE CODE FILE
EOR EQU IOMOD+1EH ;END OF PROCESSING, CLOSE FILES AND TERMINATE
;
INITS EQU SCMOD+3H ;INITIALIZE SCANNER MODULE
SCAN EQU SCMOD+6H ;SCAN NEXT TOKEN
;
INISY EQU SYMOD+3H ;INITIALIZE SYMBOL TABLE
LOOKUP EQU SYMOD+6H ;LOOKUP SYMBOL IN ACCUMULATOR
FOUND EQU SYMOD+9H ;FOUND IF NZ FLAG
ENTER EQU SYMOD+0CH ;ENTER SYMBOL IN ACCUMULATOR
SETTY EQU SYMOD+0FH ;SET TYPE FIELD
GETTY EQU SYMOD+12H ;GET TYPE FIELD
SETVAL EQU SYMOD+15H ;SET VALUE FIELD
GETVAL EQU SYMOD+18H ;GET VALUE FIELD
;
BGET EQU BMOD+6H ;BINARY SEARCH AND GET TYPE/VALUE PAIR
;
OPAND EQU OPMOD+3H ;GET OPERAND VALUE TO 'EVALUE'
MULF EQU OPMOD+6H ;MULT D,E BY H,L TO H,L
DIVF EQU OPMOD+9H ;DIVIDE HL BY DE, RESULT TO DE
;
;
; COMMON EQUATES
PBMAX EQU 120 ;MAX PRINT SIZE
PBUFF EQU 10CH ;PRINT BUFFER
PBP EQU PBUFF+PBMAX ;PRINT BUFFER POINTER
;
TOKEN EQU PBP+1 ;CURRENT TOKEN UDER SCAN
VALUE EQU TOKEN+1 ;VALUE OF NUMBER IN BINARY
ACCLEN EQU VALUE+2 ;ACCUMULATOR LENGTH
ACMAX EQU 64 ;MAX ACCUMULATOR LENGTH
ACCUM EQU ACCLEN+1
;
EVALUE EQU ACCUM+ACMAX ;VALUE FROM EXPRESSION ANALYSIS
;
SYTOP EQU EVALUE+2 ;CURRENT SYMBOL TOP
SYMAX EQU SYTOP+2 ;MAX ADDRESS+1
;
PASS EQU SYMAX+2 ;CURRENT PASS NUMBER
FPC EQU PASS+1 ;FILL ADDRESS FOR NEXT HEX BYTE
ASPC EQU FPC+2 ;ASSEMBLER'S PSEUDO PC
SYBAS EQU ASPC+2 ;BASE OF SYMBOL TABLE
SYADR EQU SYBAS+2 ;CURRENT SYMBOL ADDRESS
;
; GLOBAL EQUATES
IDEN EQU 1 ;IDENTIFIER
NUMB EQU 2 ;NUMBER
STRNG EQU 3 ;STRING
SPECL EQU 4 ;SPECIAL CHARACTER
;
PLABT EQU 0001B ;PROGRAM LABEL
DLABT EQU 0010B ;DATA LABEL
EQUT EQU 0100B ;EQUATE
SETT EQU 0101B ;SET
MACT EQU 0110B ;MACRO
;
EXTT EQU 1000B ;EXTERNAL
REFT EQU 1011B ;REFER
GLBT EQU 1100B ;GLOBAL
;
CR EQU 0DH ;CARRIAGE RETURN
LF EQU 0AH ;LINE FEED
EOF EQU 1AH ;END OF FILE
NBMAX EQU 16 ;STARTING POSITION OF PRINT LINE
;
;
RT EQU 16 ;REGISTER TYPE
PT EQU RT+1 ;PSEUDO OPERATION
PENDIF EQU 5 ;PSEUDO OPERATOR 'ENDIF'
OBASE EQU PT+1
O1 EQU OBASE+1 ;FIRST OPERATOR
O15 EQU OBASE+15;LAST OPERATOR
;
; MAIN STATEMENT PROCESSING LOOP
XRA A
STA PASS ;SET TO PASS 0 INITIALLY
CALL INISY ;INITIALIZE THE SYMBOL TABLE
RESTART: ;PASS LOOP GOES FROM 0 TO 1
CALL INITS ;INITIALIZE THE SCANNER
CALL SETUP ;SET UP THE INPUT FILE
LXI H,0
SHLD SYLAB ;ASSUME NO STARTING LABEL
SHLD FPC
SHLD ASPC
SHLD EPC ;END PC
;
SCNEXT: ;SCAN THE NEXT INPUT ITEM
CALL SCAN
SCN0: LDA TOKEN
CPI NUMB ;SKIP LEADING NUMBERS FROM LINE EDITORS
JZ SCNEXT
CPI SPECL ;MAY BE PROCESSOR TECH'S COMMENT
JNZ SCN1
; SPECIAL CHARACTER, CHECK FOR *
LDA ACCUM
CPI '*'
JNZ CHEND ;END OF LINE IF NOT *
; * FOUND, NO PRECEDING LABEL ALLOWED
CALL SETLA
JNZ STERR ;ERROR IF LABEL
JMP CHEN1 ;SCAN THE COMMENT OTHERWISE
;
SCN1: ;NOT NUMBER OR SPECIAL CHARACTER, CHECK FOR IDENTIFIER
CPI IDEN
JNZ STERR ;ERROR IF NOT
;
; IDENTIFIER FOUND, MAY BE LABEL, OPCODE, OR MACRO
CALL BGET ;BINARY SEARCH FIXED DATA
JZ CHKPT ;CHECK FOR PSEUDO OR REAL OPERATOR
;
; BINARY SEARCH WAS UNSUCCESSFUL, CHECK FOR MACRO
CALL LOOKUP
CALL FOUND
JNZ LFOUN ;NZ FLAG SET IF FOUND
;
; NOT FOUND, ENTER IT
CALL ENTER ;THIS MUST BE PASS 0
LDA PASS
ORA A
CNZ ERRP ;PHASE ERROR IF NOT
JMP SETSY ;SET SYLAB
;
; ITEM WAS FOUND, CHECK FOR MACRO
LFOUN: CALL GETTY
CPI MACT
JNZ SETSY
;
; MACRO DEFINITION FOUND, EXPAND MACRO
CALL ERRN ;NOT CURRENTLY IMPLEMENTED
JMP CHEN1 ;SCANS TO END OF CURRENT LINE
;
SETSY: ;LABEL FOUND - IS IT THE ONLY ONE?
LHLD SYLAB
MOV A,L
ORA H
CNZ ERRL ;LABEL ERROR IF NOT
LHLD SYADR ;ADDRESS OF SYMBOL
SHLD SYLAB ;MARK AS LABEL FOUND
;
; LABEL FOUND, SCAN OPTIONAL ':'
CALL SCAN
LDA TOKEN
CPI SPECL
JNZ SCN0 ;SKIP NEXT SCAN IF NOT SPECIAL
LDA ACCUM
CPI ':'
JNZ SCN0
JMP SCNEXT ;TO IGNORE ':'
;
; BINARY SEARCH FOUND SYMBOL, CHECK FOR PSEUDO OR REAL OP
CHKPT: CPI PT ;PSEUDO OPCODE?
JNZ CHKOT
;
; PSEUDO OPCODE FOUND, BRANCH TO CASES
MOV E,B ;B HAS PARTICULAR OPERATOR NUMBER
MVI D,0 ;DOUBLE PRECISION VALUE TO D,E
DCX D ;BIASED BY +1
LXI H,PTTAB ;BASE OF JUMP TABLE
DAD D
DAD D
MOV E,M
INX H
MOV H,M
MOV L,E
PCHL ;JUMP INTO TABLE
;
PTTAB: ;PSEUDO OPCODE JUMP TABLE
DW SDB ;DB
DW SDS ;DS
DW SDW ;DW
DW SEND ;END
DW SENDIF ;ENDIF
DW SENDM ;ENDM
DW SEQU ;EQU
DW SIF ;IF
DW SMACRO ;MACRO
DW SORG ;ORG
DW SSET ;SET
DW STITLE ;TITLE
;
SDB:
CALL FILAB ;SET LABEL FOR THIS LINE TO ASPC
SDB0:
CALL SCAN ;PAST DB TO NEXT ITEM
LDA TOKEN ;LOOK FOR LONG STRING
CPI STRNG
JNZ SDBC ;SKIP IF NOT STRING
LDA ACCLEN
DCR A ;LENGTH 1 STRING?
JZ SDBC
; LENGTH 0,2,... STRING
MOV B,A
INR B
INR B ;BECOMES 1,3,... FOR 0,2,... LENGTHS
LXI H,ACCUM ;ADDRESS CHARACTERS IN STRING
SDB1: DCR B ;COUNT DOWN TO ZERO
JZ SDB2 ;SCAN DELIMITER AT END OF STRING
PUSH B ;SAVE COUNT
MOV B,M ;GET CHARACTER
INX H
PUSH H ;SAVE ACCUM POINTER
CALL FILHB ;SEND TO HEX FILE
POP H
POP B
JMP SDB1
SDB2: CALL SCAN ;TO THE DELIMITER
JMP SDB3
;
; NOT A LONG STRING
SDBC: CALL OPAND ;COMPUTE OPERAND
LHLD EVALUE ;VALUE TO H,L
MOV A,H
ORA A ;HIGH ORDER MUST BE ZERO
CNZ ERRD ;DATA ERROR
MOV B,L ;GET LOW BYTE
CALL FILHB
SDB3: ;END OF ITEM - UPDATE ASPC
CALL SETAS ;SET ASPC TO FPC
CALL DELIM
CPI ','
JZ SDB0 ;FOR ANOTHER ITEM
JMP CHEND ;CHECK END OF LINE SYNTAX
;
SDS:
CALL FILAB ;HANDLE LABEL IF IT OCCURRED
CALL PADD ;PRINT ADDRESS
CALL EXP16 ;SCAN AND GET 16BIT OPERAND
XCHG ;TO D,E
LHLD ASPC ;CURRENT PSEUDO PC
DAD D ;+EXPRESSION
SHLD ASPC
SHLD FPC ;NEXT TO FILL
JMP CHEND
;
SDW:
CALL FILAB ;HANDLE OPTIONAL LABEL
SDW0:
CALL EXP16 ;GET 16BIT OPERAND
PUSH H ;SAVE A COPY
MOV B,L ;LOW BYTE FIRST
CALL FILHB ;SEND LOW BYTE
POP H ;RECLAIM A COPY
MOV B,H ;HIGH BYTE NEXT
CALL FILHB ;SEND HIGH BYTE
CALL SETAS ;SET ASPC=FPC
CALL DELIM ;CHECK DELIMITER SYNTAX
CPI ','
JZ SDW0 ;GET MORE DATA
JMP CHEND
;
SEND:
CALL FILAB
CALL PADD ;WRITE LAST LOC
LDA PBUFF
CPI ' '
JNZ CHEND
CALL EXP16 ;GET EXPRESSION IF IT'S THERE
LDA PBUFF
CPI ' '
JNZ SEND0
SHLD EPC ;EXPRESSION FOUND, STORE IT FOR LATER
SEND0: MVI A,' '
STA PBUFF ;CLEAR ERROR, IF IT OCCURRED
CALL SCAN ;CLEAR CR
LDA TOKEN
CPI SPECL
JNZ STERR
LDA ACCUM
CPI LF
JNZ STERR
JMP ENDAS ;END OF ASSEMBLER
;
SENDIF:
JMP POEND
;
SENDM:
CALL ERRN
JMP POEND
;
SEQU:
CALL SETLA
JZ STERR ;MUST BE A LABEL
LHLD ASPC ;HOLD TEMP ASPC
PUSH H ;IN STACK
CALL EXP16 ;GET 16BIT OPERAND
SHLD ASPC ;VALUE OF EXPRESSION
CALL FILAB
CALL PADDR ;COMPUTED VALUE
LXI H,PBUFF+6 ;SPACE AFTER VALUE
MVI M,'='
POP H ;REAL ASPC
SHLD ASPC ;CHANGE BACK
JMP CHEND
;
SIF:
CALL FILAB ;IN CASE OF LABEL
CALL EXP16 ;GET IF EXPRESSION
LDA PBUFF
CPI ' '
JNZ CHEND ;SKIP IF ERROR
MOV A,L ;GET LSB
RAR
JC CHEND ;TRUE IF CARRY BIT SET
;
; SKIP TO EOF OR ENDIF
SIF0: CALL SCAN
LDA TOKEN
CPI SPECL
JNZ SIF1
LDA ACCUM
CPI EOF
MVI A,'B' ;BALANCE ERROR
CZ PERR
JZ ENDAS
JMP SIF0 ;FOR ANOTHER
SIF1: ;NOT A SPECIAL CHARACTER
CPI IDEN
JNZ SIF0 ;NOT AN IDENTIFIER
CALL BGET ;LOOK FOR ENDIF
JNZ SIF0 ;NOT FOUND
CPI PT ;PSEUDO OP?
JNZ SIF0
MOV A,B ;GET OPERATOR NUMBER
CPI PENDIF ;ENDIF?
JNZ SIF0 ;GET ANOTHER TOKEN
JMP POEND ;OK, CHECK END OF LINE
;
SMACRO:
CALL ERRN
JMP CHEND
;
SORG:
CALL EXP16
LDA PBUFF
CPI ' '
JNZ CHEND ;SKIP ORG IF ERROR
SHLD ASPC ;CHANGE PC
SHLD FPC ;CHANGE NEXT TO FILL
CALL FILAB ;IN CASE OF LABEL
CALL PADD
JMP CHEND
;
SSET:
CALL SETLA
JZ STERR ;MUST BE LABELLED
;
CALL GETTY
CPI SETT
CNZ ERRL ;LABEL ERROR
MVI A,SETT
CALL SETTY ;REPLACE TYPE WITH 'SET'
CALL EXP16 ;GET THE EXPRESSION
PUSH H ;SAVE IT
CALL SETLA ;RE-ADDRESS LABEL
POP H ;RECLAIM IT
CALL SETVAL
LXI H,0
SHLD SYLAB ;PREVENT LABEL PROCESSING
JMP CHEND
;
;
STITLE:
CALL ERRN ;NOT IMPLEMENTED
;
POEND: ;PSEUDO OPERATOR END - SCAN TO NEXT TOKEN
CALL SCAN
JMP CHEND
;
; NOT A PSEUDO OPCODE, CHECK FOR REAL OPCODE
CHKOT: SUI O1 ;BASE OF OPCODES
CPI O15 ;PAST LAST OPCODE?
JNC STERR ;STATEMENT ERROR IF SO
;
; FOUND OPCODE, COMPUTE INDEX INTO TABLE AND JUMP TO CASE
MOV E,A
MVI D,0
LXI H,OPTAB
DAD D
DAD D
MOV E,M
INX H
MOV H,M
MOV L,E
PCHL ;JUMP TO CASE
;
OPTAB: ;OPCODE CATEGORIES
DW SSIMP ;SIMPLE
DW SLXI ;LXI
DW SDAD ;DAD
DW SPUSH ;PUSH/POP
DW SJMP ;JMP/CALL
DW SMOV ;MOV
DW SMVI ;MVI
DW SACCI ;ACCUM IMMEDIATE
DW SLDAX ;LDAX/STAX
DW SLHLD ;LHLD/SHLD/LDA/STA
DW SACCR ;ACCUM-REGISTER
DW SINC ;INC/DCR
DW SINX ;INX/DCX
DW SRST ;RESTART
DW SIN ;IN/OUT
;
SSIMP: ;SIMPLE OPERATION CODES
CALL FILHB ;SEND HEX VALUE TO MACHINE CODE FILE
CALL SCAN ;TO NEXT TOKEN
JMP INCPC
;
SLXI: ;LXI H,16B
CALL SHDREG ;SCAN DOUBLE PRECISION REGISTER
CALL CHCOM ;CHECK FOR COMMA FOLLOWING REGISTER
CALL SETADR ;SCAN AND EMIT DOUBLE PRECISION OPERAND
JMP INCPC
;
SDAD: ;DAD B
CALL SHDREG ;SCAN AND EMIT DOUBLE PRECISION REGISTER
JMP INCPC
;
SPUSH: ;PUSH B POP D
CALL SHREG ;SCAN SINGLE PRECISION REGISTER TO A
CPI 111000B ;MAY BE PSW
JZ SPU0
; NOT PSW, MUST BE B,D, OR H
ANI 001000B ;LOW BIT MUST BE 0
CNZ ERRR ;REGISTER ERROR IF NOT
SPU0: MOV A,C ;RECALL REGISTER AND MASK IN CASE OF ERROR
ANI 110000B
ORA B ;MASK IN OPCODE FOR PUSH OR POP
JMP FILINC ;FILL HEX VALUE AND INCREMENT PC
;
SJMP: ;JMP 16B/ CALL 16B
CALL FILHB ;EMIT JMP OR CALL OPCODE
CALL SETADR ;EMIT 16BIT OPERAND
JMP INCPC
;
SMOV: ;MOV A,B
CALL SHREG
ORA B ;MASK IN OPCODE
MOV B,A ;SAVE IN B TEMPORARILY
CALL CHCOM ;MUST BE COMMA SEPARATOR
CALL EXP3 ;VALUE MUST BE 0-7
ORA B ;MASK IN OPCODE
JMP FILINC
;
SMVI: ;MVI A,8B
CALL SHREG
ORA B ;MASK IN OPCODE
CALL FILHEX ;EMIT OPCODE
CALL CHCOM ;SCAN COMMA
CALL SETBYTE ;EMIT 8BIT VALUE
JMP INCPC
;
SACCI: ;ADI 8B
CALL FILHB ;EMIT IMMEDIATE OPCODE
CALL SETBYTE ;EMIT 8BIT OPERAND
JMP INCPC
;
SLDAX: ;LDAX B/STAX D
CALL SHREG
ANI 101000B ;MUST BE B OR D
CNZ ERRR ;REGISTER ERROR IF NOT
MOV A,C ;RECOVER REGISTER NUMBER
ANI 010000B ;CHANGE TO B OR D IF ERROR
ORA B ;MASK IN OPCODE
JMP FILINC ;EMIT OPCODE
;
SLHLD: ;LHLD 16B/ SHLD 16B/ LDA 16B/ STA 16B
CALL FILHB ;EMIT OPCODE
CALL SETADR ;EMIT OPERAND
JMP INCPC
;
SACCR: ;ADD B
CALL EXP3 ;RIGHT ADJUSTED 3BIT VALUE FOR REGISTER
ORA B ;MASK IN OPCODE
JMP FILINC
;
SINC: ;INR B/DCR D
CALL SHREG ;GET REGISTER
ORA B
JMP FILINC
;
SINX: ;INX H/DCX B
CALL SHREG
ANI 001000B ;MUST BE B D M OR SP
CNZ ERRR ;REGISTER ERROR IF NOT
MOV A,C ;RECOVER REGISTER
ANI 110000B ;IN CASE OF ERROR
ORA B ;MASK IN OPCODE
JMP FILINC
;
SRST: ;RESTART 4
CALL SHREG ;VALUE IS 0-7
ORA B ;OPCODE MASKED
JMP FILINC
;
SIN: ;IN 8B/OUT 8B
CALL FILHB ;EMIT OPCODE
CALL SETBYTE ;EMIT 8BIT OPERAND
JMP INCPC
;
FILINC: ;FILL HEX VALUE FROM A BEFORE INCREMENTING PC
CALL FILHEX
;
INCPC: ;CHANGE ASSEMBLER'S PSEUDO PROGRAM COUNTER
CALL FILAB ;SET ANY LABELS WHICH OCCUR ON THE LINE
CALL SETAS ;ASPC=FPC
JMP CHEND ;END OF LINE SCAN
;
;
; UTILITY SUBROUTINES FOR OPERATION CODES
;
DELIM: ;CHECK DELIMITER SYNTAX FOR DATA STATEMENTS
LDA TOKEN
CPI SPECL
CNZ ERRD
LDA ACCUM
CPI ','
RZ
CPI ';'
RZ
CPI CR
CNZ ERRD
RET
;
EXP16: ;GET 16BIT VALUE TO H,L
PUSH B
CALL SCAN ;START SCANNING OPERAND FIELD
CALL OPAND
LHLD EVALUE ;VALUE TO H,L
POP B
RET
;
EXP8: ;GET 8BIT VALUE TO REG A
CALL EXP16
MOV A,H
ORA A
CNZ ERRV ;VALUE ERROR IF HIGH BYTE NOT ZERO
MOV A,L
RET
;
EXP3: ;GET 3BIT VALUE TO REG A
CALL EXP8
CPI 8
CNC ERRV ;VALUE ERROR IF >=8
ANI 111B ;REDUCE IF ERROR OCCURS
RET
;
SHREG: ;GET 3BIT VALUE AND SHIFT LEFT BY 3
CALL EXP3
RAL
RAL
RAL
ANI 111000B
MOV C,A ;COPY TO C
RET
;
SHDREG: ;GET DOUBLE REGISTER TO A
CALL SHREG
ANI 001000B ;CHECK FOR A,C,E, OR L
CNZ ERRR ;REGISTER ERROR
MOV A,C ;RECOVER REGISTER
ANI 110000B ;FIX IT IF ERROR OCCURRED
ORA B ;MASK OPCODE
JMP FILHEX ;EMIT IT
;
SETBYTE: ;EMIT 16BIT OPERAND
CALL EXP8
JMP FILHEX
;
SETADR: ;EMIT 16BIT OPERAND
CALL EXP16
JMP FILADR
;
CHCOM: ;CHECK FOR COMMA FOLLOWING EXPRESSION
PUSH PSW
PUSH B
LDA TOKEN
CPI SPECL
JNZ COMER
; SPECIAL CHARACTER, CHECK FOR COMMA
LDA ACCUM
CPI ','
JZ COMRET ;RETURN IF COMMA FOUND
COMER: ;COMMA ERROR
MVI A,'C'
CALL PERR
COMRET:
POP B
POP PSW
RET
;
CHEND: ;END OF LINE CHECK
CALL FILAB ;IN CASE OF A LABEL
LDA TOKEN
CPI SPECL
JNZ STERR ;MUST BE A SPECIAL CHARACTER
LDA ACCUM
CPI CR ;CARRIAGE RETURN
JNZ CHEN0
; CARRIAGE RETURN FOUND, SCAN PICKS UP LF AND PUSHES LINE
CALL SCAN
JMP SCNEXT
;
CHEN0: ;NOT CR, CHECK FOR COMMENT
CPI ';'
JNZ CHEN2
CALL FILAB ;IN CASE LABELLED EMPTY LINE
; CLEAR COMMENT TO END OF LINE
CHEN1: CALL SCAN
LDA TOKEN
CPI SPECL
JNZ CHEN1
LDA ACCUM
CPI LF
JZ SCNEXT
CPI EOF
JZ ENDAS ;END OF ASSEMBLY IF EOF
CPI '!'
JZ SCNEXT ;LOGICAL END OF LINE
JMP CHEN1 ;NONE OF THE ABOVE
;
; NOT CR OR LF, MAY BE LOGICAL END OF LINE
CHEN2: CPI '!'
JZ SCNEXT
CPI EOF
JZ ENDAS
;
; STATEMENT ERROR IN OPERAND FIELD
STERR: MVI A,'S'
CALL PERR
JMP CHEN1 ;TO DUMP LINE
;
DIFF: ;COMPUTE DE-HL TO HL
MOV A,E
SUB L
MOV L,A
MOV A,D
SBB H
MOV H,A
RET
;
ENDAS: ;END OF ASSEMBLY FOR THIS PASS
LXI H,PASS
MOV A,M
INR M ;PASS NUMBER INCREMENTED
ORA A
JZ RESTART
CALL SCAN ;TO CLEAR LAST LINE FEED
CALL PADD ;WRITE LAST ADDRESS
LXI H,PBUFF+5
MVI M,CR ;SET TO CR FOR END OF MESSAGE
LXI H,PBUFF+1
CALL PCON ;PRINT LAST ADDRESS
;
; COMPUTE REMAINING SPACE
LHLD SYTOP
XCHG
LHLD SYBAS
CALL DIFF ;DIFFERENCE TO H,L
PUSH H ;SYTOP-SYBAS TO STACK
LHLD SYMAX
XCHG
LHLD SYBAS
CALL DIFF ;SYMAX-SYBAS TO H,L
MOV E,H
MVI D,0 ;DIVIDED BY 256
POP H ;SYTOP-SYBAS TO H,L
CALL DIVF ;RESULT TO DE
XCHG
CALL PADDR ;PRINT H,L TO PBUFF
LXI H,PBUFF+5 ;MESSAGE
LXI D,EMSG ;END MESSAGE
ENDA0: LDAX D
ORA A ;ZERO?
JZ ENDA1
MOV M,A
INX H
INX D
JMP ENDA0
;
EMSG: DB 'H USE FACTOR',CR,0
;
ENDA1: LXI H,PBUFF+2 ;BEGINNING OF RATIO
CALL PCON
LHLD EPC
SHLD FPC ;END PROGRAM COUNTER
JMP EOR
;
; UTILITY SUBROUTINES
COMDH: ;COMPARE D,E WITH H,L FOR EQUALITY (NZ FLAG IF NOT EQUAL)
MOV A,D
CMP H
RNZ
MOV A,E
CMP L
RET
;
SETAS: ;ASPC=FPC
LHLD FPC
SHLD ASPC
RET
;
SETLA: ;SYADR=SYLAB, FOLLOWED BY CHECK FOR ZERO
LHLD SYLAB
SHLD SYADR
CALL FOUND
RET
;
FILAB: ;FILL LABEL VALUE WITH CURRENT ASPC, IF LABEL FOUND
CALL SETLA
RZ ;RETURN IF NO LABEL DETECTED
;
; LABEL FOUND, MUST BE DEFINED ON PASS-1
LXI H,0
SHLD SYLAB ;TO MARK NEXT STATEMENT WITH NO LABEL
LDA PASS
ORA A
JNZ FIL1
;
; PASS 0
CALL GETTY
PUSH PSW ;SAVE A COPY OF TYPE
ANI 111B ;CHECK FOR UNDEFINED
CNZ ERRL ;LABEL ERROR
POP PSW ;RESTORE TYPE
ORI PLABT ;SET TO LABEL TYPE
CALL SETTY ;SET TYPE FIELD
LHLD ASPC ;GET CURRENT PC
CALL SETVAL ;PLACE INTO VALUE FIELD
RET
;
FIL1: ;CHECK FOR DEFINED VALUE
CALL GETTY
ANI 111B
CZ ERRP ;PHASE ERROR
; GET VALUE AND COMPARE WITH ASPC
CALL GETVAL ;TO H,L
XCHG
LHLD ASPC
CALL COMDH
CNZ ERRP ;PHASE ERROR IF NOT THE SAME
RET
;
FILHEX: ;WRITE HEX BYTE IN REGISTER A TO MACHINE CODE FILE IF PASS-1
MOV B,A
FILHB: LDA PASS
ORA A
MOV A,B
JZ FILHI
;
; PASS - 1, WRITE HEX AND PRINT DATA
PUSH B ;SAVE A COPY
CALL DHEX ;INTO MACHINE CODE FILE
; MAY BE COMPLETELY EMPTY LINE, SO CHECK ADDRESS
LDA PBUFF+1
CPI ' '
LHLD ASPC
CZ PADDR ;PRINT ADDRESS FIELD
;
LDA NBP
CPI NBMAX ;TRUNCATE CODE IF TOO MUCH ON THIS LINE
POP B ;RECALL HEX DIGIT
JNC FILHI
; ROOM FOR DIGIT ON THIS LINE
MOV A,B
CALL WHEXB ;WRITE HEX BYTE TO PRINT LINE
FILHI: LHLD FPC
INX H
SHLD FPC ;READY FOR NEXT BYTE
RET
;
FILADR: ;EMIT DOUBLE PRECISION VALUE FROM H,L
PUSH H ;SAVE A COPY
MOV B,L
CALL FILHB ;LOW BYTE EMITTED
POP H ;RECOVER A COPY OF H,L
MOV B,H
JMP FILHB ;EMIT HIGH BYTE AND RETURN
;
; UTILITY FUNCTIONS FOR PRINTING HEX ADDRESSES AND DATA
CHEX: ;CONVERT TO HEX
ADI '0'
CPI '0'+10
RC
ADI 'A'-'0'-10
RET
;
WHEXN: ;WRITE HEX NIBBLE
CALL CHEX ;CONVERT TO ASCII FROM HEX
LXI H,NBP
MOV E,M ;NEXT POSITION TO PRINT
MVI D,0 ;DOUBLE PRECISION
INR M ;NBP=NBP+1
LXI H,PBUFF
DAD D
MOV M,A ;STORE IN PRINT BUFFER
RET
;
WHEXB: ;WRITE HEX BYTE TO PRINT BUFFER
PUSH PSW
RAR
RAR
RAR
RAR
ANI 0FH ;HIGH ORDER NIBBLE NORMALIZE IN A
CALL WHEXN ;WRITE IT
POP PSW
ANI 0FH
JMP WHEXN ;WRITE AND RETURN
;
PADD: LHLD ASPC
PADDR: ;PRINT ADDRESS FIELD OF PRINT LINE FROM H,L
XCHG
LXI H,NBP ;INITIALIZE NEXT TO FILL
PUSH H ;SAVE A COPY OF NBP'S ADDRESS
MVI M,1
MOV A,D ;PRINT HIGH BYTE
PUSH D ;SAVE A COPY
CALL WHEXB
POP D
MOV A,E
CALL WHEXB
POP H ;ADDRESSING NBP
INR M ;SKIP A SPACE AFTER ADDRESS FIELD
RET
;
ERRR: ;EMIT REGISTER ERROR
PUSH PSW
PUSH B
MVI A,'R'
CALL PERR
POP B
POP PSW
RET
;
ERRV: ;EMIT VALUE ERROR
PUSH PSW
PUSH H
MVI A,'V'
CALL PERR
POP H
POP PSW
RET
;
ERRD: PUSH PSW
MVI A,'D' ;DATA ERROR
JMP ERR
;
ERRP: PUSH PSW
MVI A,'P'
JMP ERR
;
ERRL: PUSH PSW
MVI A,'L' ;LABEL ERROR
JMP ERR
;
ERRN: PUSH PSW
MVI A,'N' ;NOT IMPLEMENTED
;
ERR:
CALL PERR
POP PSW
RET
;
SYLAB: DS 2 ;ADDRESS OF LINE LABEL
EPC: DS 2 ;END PC VALUE
NBP: DS 1 ;NEXT BYTE POSITION TO WRITE FOR MACHINE CODE
END


422
CPM OPERATING SYSTEMS/CPM 2.X/CPM 2.0/cpmove.asm Normal file
View File

@@ -0,0 +1,422 @@
TITLE 'CP/M VERSION 2.0 SYSTEM RELOCATOR - 8/79'
; CPM RELOCATOR PROGRAM, INCLUDED WITH THE MODULE TO PERFORM
; THE MOVE FROM 900H TO THE DESTINATION ADDRESS
;
; COPYRIGHT (C) 1979
; DIGITAL RESEARCH
; BOX 579, PACIFIC GROVE CALIFORNIA
; 93950
;
ORG 100H
JMP PASTCOPY
COPY: DB 'COPYRIGHT (C) DIGITAL RESEARCH, 1979 '
PASTCOPY:
BIOSWK EQU 03H ;THREE PAGES FOR BIOS WORKSPACE
STACK EQU 800H
MODSIZ EQU 801H ;MODULE SIZE IS STORED HERE
VERSION EQU 20 ;CPM VERSION NUMBER
BOOTSIZ EQU 100H ;SIZE OF THE COLD START LOADER
; (MAY HAVE FIRST 80H BYTES = 00H)
BDOSL EQU 0800H ;RELATIVE LOCATION OF BDOS
BIOS EQU 1600H ;RELATIVE LOCATION OF BIOS
;
BOOT EQU 0000H ;REBOOT LOCATION
BDOS EQU 0005H
PRNT EQU 9 ;PRINT BUFFER FUNCTION
FCB EQU 5CH ;DEFAULT FCB
MODULE EQU 900H ;MODULE ADDRESS
;
CR EQU 0DH
LF EQU 0AH
LXI SP,STACK
;
; MAY BE MEMORY SIZE SPECIFIED IN COMMAND
LXI D,FCB+1
LDAX D
CPI ' '
JZ FINDTOP
CPI '?' ;WAS * SPECIFIED?
JZ FINDTOP
;
; MUST BE MEMORY SIZE SPECIFICATION
LXI H,0
CLOOP: ;CONVERT TO DECIMAL
LDAX D
INX D
CPI ' '
JZ ECON
ORA A
JZ ECON
; MUST BE DECIMAL DIGIT
SUI '0'
CPI 10
JNC CERROR
; DECIMAL DIGIT IS IN A
DAD H ;*2
PUSH H
DAD H ;*4
DAD H ;*8
POP B ;*2 IN B,C
DAD B ;*10 IN H,L
MOV C,A
MVI B,0
DAD B ;*10+X
JMP CLOOP
ECON: ;END OF CONVERSION, CHECK FOR PROPER RANGE
MOV A,H
ORA A
JNZ CERROR
MOV A,L
CPI 16
JC CERROR
MVI L,0
MOV H,A
DAD H ;SHL 1
DAD H ;SHL 2 FOR KILOBYTES
; H,L HAVE TOP OF MEMORY+1
JMP SETASC
;
CERROR:
LXI D,CONMSG
CALL PRINT
JMP BOOT
CONMSG: DB CR,LF,'INVALID MEMORY SIZE$'
;
;
; FIND END OF MEMORY
FINDTOP:
LXI H,0
FINDM: INR H ;TO NEXT PAGE
JZ MSIZED ;CAN OVERFLOW ON 64K SYSTEMS
MOV A,M
CMA
MOV M,A
CMP M
CMA
MOV M,A ;BITS INVERTED FOR RAM OPERATIONAL TEST
JZ FINDM
; BITS DIDN'T CHANGE, MUST BE END OF MEMORY
; ALIGN ON EVEN BOUNDARY
MSIZED: MOV A,H
ANI 1111$1100B ;EVEN 1K BOUNDARY
MOV H,A
SETASC: ;SET ASCII VALUE OF MEMORY SIZE
PUSH H ;SAVE FOR LATER
; **** SERIALIZATION ****
LHLD BDOS+1
SHLD SER1
; **** SERIALIZATION ****
POP H
PUSH H
MOV A,H
RRC
RRC
ANI 11$1111B ;FOR 1K COUNTS
JNZ NOT64 ;MAY BE 64 K MEM SIZE
MVI A,64 ;SET TO LITERAL IF SO
NOT64: MOV B,A ;READY FOR COUNT DOWN
LXI H,AMEM
MVI A,'0'
MOV M,A
INX H
MOV M,A ;BOTH ARE SET TO ASCII 0
ASC0: LXI H,AMEM+1 ;ADDRESS OF ASCII EQUIVALENT
INR M
MOV A,M
CPI '9'+1
JC ASC1
MVI M,'0'
DCX H
INR M
ASC1: DCR B ;COUNT DOWN BY KILOBYTES
JNZ ASC0
LXI D,MEMSG
CALL PRINT ;MEMORY SIZE MESSAGE
;
LXI H,MODSIZ
MOV C,M
INX H
MOV B,M ;B,C CONTAINS MODULE SIZE
PUSH B ;MODULE SIZE STACKED ON MEM SIZE
;
; TRY TO FIND THE ASCII STRING 'K CP/M VER X.X' TO SET SIZE
LXI H,MODULE
; B,C CONTAINS MODULE LENGTH
SLOOP: ;SEARCH LOOP
LXI D,AMSG
MOV A,B
ORA C
JZ ESEAR ;END OF SEARCH
DCX B ;COUNT SEARCH LENGTH DOWN
PUSH B
MVI C,LAMSG ;LENGTH OF SEARCH MESSAGE
PUSH H ;SAVE BASE ADDRESS OF SEARCH
CHLOOP: ;CHARACTER LOOP, MATCH ON CONTENTS OF D,E AND H,L
LDAX D
CMP M
JNZ NOMATCH
INX D ;TO NEXT SEARCH CHARACTER
INX H ;TO NEXT MATCH CHARACTER
DCR C ;COUNT LENGTH DOWN
JZ FSEAR ;FOUND SEARCH STRING
JMP CHLOOP
;
; **** SERIALIZATION ****
DB LXI ;CONFUSE DISASSEMBLER
BADSER: ;BAD SERIAL NUMBER, LOOP TO CONFUSE ICE-80
XRA A
BADSER0:
DCR A
JNZ BADSER0
;
LXI H,DI OR (HLT SHL 8)
SHLD PRHLT
LXI H,PRJMP
MVI M,CALL ;CHANGE JMP BDOS TO CALL
LXI D,SYNCMSG-5
LXI H,5
DAD D ;TO CONFUSE SEARCHES ON ADDRESSES
XCHG
JMP PRINT
; **** SERIALIZATION ****
;
NOMATCH:
;NOT FOUND AT THIS ADDRESS, LOOK AT NEXT ADDRESS
POP H
INX H
POP B ;RECALL MODULE LENGTH
JMP SLOOP
;
FSEAR:
;FOUND STRING, SET MEMORY SIZE
POP H ;START ADDRESS OF STRING BEING MATCHED
POP B ;CLEAR B,C WHICH WAS STACKED
DCX H
LXI D,AMEM+1
LDAX D
MOV M,A
DCX H
DCX D
LDAX D
MOV M,A
; END OF FILL
;
ESEAR: ;END OF SEARCH
; **** SERIALIZATION ****
; CHECK FOR LEAST SIGNIFICANT BYTE OF 06 IN SER1
LXI B,SER1
LDAX B
CPI 6
MVI A,0
JNZ SETJMP ;BAD SERIALIZATION IF NOT 06
STAX B ;STORE 00 TO LEAST SIGNIFICANT BYTE
; **** SERIALIZATION ****
POP B ;RECOVER MODULE LENGTH
POP H ;H,L CONTAINS END OF MEMORY
PUSH B ;SAVE LENGTH FOR RELOCATION BELOW
MOV A,B
ADI BIOSWK ;ADD BIOS WORK SPACE TO MODULE LENGTH
MOV B,A
MOV A,L
SUB C ;COMPUTE MEMTOP-MODULE SIZE
MOV L,A
MOV A,H
SBB B
MOV H,A
; H,L CONTAINS THE BASE OF THE RELOCATION AREA
SHLD RELBAS ;SAVE THE RELOCATION BASE
XCHG ;MODULE BASE TO D,E
LXI H,MODULE;READY FOR THE MOVE
POP B ;RECOVER ACTUAL MODULE LENGTH
PUSH B ;SAVE FOR RELOCATION
LDA FCB+17 ;CHECK FOR NO MOVE CONDITION
CPI ' '
JZ MOVE
; SECOND PARAMETER SPECIFIED, LEAVE THE DATA AT 'MODULE'
DAD B ;MOVE H,L TO BIT MAP POSITION
JMP RELOC
;
; **** SERIALIZATION ****
SETJMP: LXI H,BADSER ;BAD SERIALIZATION
SHLD JMPSER+1 ;FILL JUMP INSTRUCTION
JMP JMPSER ;EVENTUAL JUMP TO MESSAGE
; **** SERIALIZATION ****
;
MOVE:
MOV A,B ;BC=0?
ORA C
JZ RELOC
DCX B ;COUNT MODULE SIZE DOWN TO ZERO
MOV A,M ;GET NEXT ABSOLUTE LOCATION
STAX D ;PLACE IT INTO THE RELOC AREA
INX D
INX H
JMP MOVE
;
RELOC: ;STORAGE MOVED, READY FOR RELOCATION
; HL ADDRESSES BEGINNING OF THE BIT MAP FOR RELOCATION
POP B ;RECALL MODULE LENGTH
PUSH H ;SAVE BIT MAP BASE IN STACK
LHLD RELBAS
XCHG
LXI H,BOOTSIZ
DAD D ;TO FIND BIAS VALUE
; REGISTER H CONTAINS BIAS VALUE
;
; RELOCATE AT 'MODULE' IF SECOND PARAMETER GIVEN
LDA FCB+17
CPI ' '
JZ REL0
;
; IMAGE NOT MOVED, ADJUST VALUES AT 'MODULE'
LXI D,MODULE
REL0: MOV A,B ;BC=0?
ORA C
JZ ENDREL
; **** SERIALIZATION ****
JMP PASTSYNC
SYNCMSG:
DB CR,LF,'SYNCRONIZATION ERROR$'
PASTSYNC:
; **** SERIALIZATION ****
;
; NOT END OF THE RELOCATION, MAY BE INTO NEXT BYTE OF BIT MAP
DCX B ;COUNT LENGTH DOWN
MOV A,E
ANI 111B ;0 CAUSES FETCH OF NEXT BYTE
JNZ REL1
; FETCH BIT MAP FROM STACKED ADDRESS
XTHL
MOV A,M ;NEXT 8 BITS OF MAP
INX H
XTHL ;BASE ADDRESS GOES BACK TO STACK
MOV L,A ;L HOLDS THE MAP AS WE PROCESS 8 LOCATIONS
REL1: MOV A,L
RAL ;CY SET TO 1 IF RELOCATION NECESSARY
MOV L,A ;BACK TO L FOR NEXT TIME AROUND
JNC REL2 ;SKIP RELOCATION IF CY=0
;
; CURRENT ADDRESS REQUIRES RELOCATION
LDAX D
ADD H ;APPLY BIAS IN H
STAX D
JMP REL2
;
REL2: INX D ;TO NEXT ADDRESS
JMP REL0 ;FOR ANOTHER BYTE TO RELOCATE
;
ENDREL: ;END OF RELOCATION
POP D ;CLEAR STACKED ADDRESS
; **** SERIALIZATION ****
LXI D,MODULE+BDOSL+BOOTSIZ ;ADDRESSING NEW SERIAL NUMBER
LHLD SER1 ;ADDRESSING HOST SERIAL NUMBER
MVI C,6 ;LENGTH OF SERIAL NUMBER
CHKSER: LDAX D
CMP M
JNZ SETJMP
INX H
INX D
DCR C
JNZ CHKSER
; **** SERIALIZATION ****
;
LDA FCB+17
CPI ' '
JZ TRANSFER
; DON'T GO TO THE LOADED PROGRAM, LEAVE IN MEMORY
; MAY HAVE TO MOVE THE PROGRAM IMAGE DOWN 1/2 PAGE
MVI B,128 ;CHECK FOR 128 ZEROES
LXI H,MODULE
TR0: MOV A,M
ORA A
JNZ TREND
INX H
DCR B
JNZ TR0
;
; ALL ZERO FIRST 1/2 PAGE, MOVE DOWN 80H BYTES
XCHG ;NEXT TO GET IN D,E
LHLD MODSIZ
LXI B,-128
DAD B ;NUMBER OF BYTES TO MOVE IN H,L
MOV B,H
MOV C,L ;TRANSFERRED TO B,C
LXI H,MODULE;DESTINATION IN H,L
TRMOV: MOV A,B
ORA C ;ALL MOVED?
JZ TREND
DCX B
LDAX D
MOV M,A ;ONE BYTE TRANSFERRED
INX D
INX H
JMP TRMOV
;
;
; **** SERIALIZATION ****
DB LXI
JMPSER: JMP JMPSER ;ADDRESS FIELD FILLED-IN
; **** SERIALIZATION ****
;
TREND: ;SET ASCII MEMORY IMAGE SIZE
LXI H,MODSIZ
MOV C,M
INX H
MOV B,M
LXI H,MODULE;B,C MODULE SIZE, H,L BASE
DAD B
MOV B,H ;B CONTAINS NUMBER OF PAGES TO SAVE+1
LXI H,SAVMEM;ASCII MEMORY SIZE
MVI A,'0'
MOV M,A
INX H
MOV M,A
; '00' STORED INTO MESSAGE
TRCOMP:
DCR B
JZ TRC1
LXI H,SAVMEM+1 ;ADDRESSING LEAST DIGIT
INR M
MOV A,M
CPI '9'+1
JC TRCOMP
MVI M,'0'
DCX H
INR M
JMP TRCOMP
; FILL CPMXX.COM FROM SAVMEM
TRC1: LHLD AMEM
SHLD SAVM0
; MESSAGE SET, PRINT IT AND REBOOT
LXI D,RELOK
CALL PRINT
JMP BOOT
RELOK: DB CR,LF,'READY FOR "SYSGEN" OR'
DB CR,LF,'"SAVE '
SAVMEM: DB '00 CPM'
SAVM0: DB '00.COM"$'
;
TRANSFER:
; GO TO THE RELOCATED MEMORY IMAGE
LXI D,BOOTSIZ+BIOS ;MODULE
LHLD RELBAS ;RECALL BASE OF RELOC AREA
DAD D ;INDEX TO 'BOOT' ENTRY POINT
PCHL ;GO TO RELOCATED PROGRAM
;
; **** SERIALIZATION ****
PRINT:
MVI C,PRNT
PRJMP: JMP BDOS
PRHLT:
;
; DATA AREAS
SER1: DS 2 ;SERIAL NUMBER ADDRESS FOR HOST
RELBAS: DS 2 ;RELOCATION BASE
MEMSG: DB CR,LF,'CONSTRUCTING '
AMEM: DB '00'
AMSG: DB 'k CP/M vers '
DB VERSION/10+'0','.',VERSION MOD 10 +'0'
LAMSG EQU $-AMSG ;LENGTH OF MESSAGE
DB '$' ;TERMINATOR FOR MESSAGE
END


87
CPM OPERATING SYSTEMS/CPM 2.X/CPM 2.0/ddt0mov.asm Normal file
View File

@@ -0,0 +1,87 @@
; DDT RELOCATOR PROGRAM, INCLUDED WITH THE MODULE TO PERFORM
; THE MOVE FROM 200H TO THE DESTINATION ADDRESS
VERSION EQU 14 ;1.4
;
; COPYRIGHT (C) 1976, 1977, 1978
; DIGITAL RESEARCH
; BOX 579 PACIFIC GROVE
; CALIFORNIA 93950
;
ORG 100H
STACK EQU 200H
BDOS EQU 0005H
PRNT EQU 9 ;BDOS PRINT FUNCTION
MODULE EQU 200H ;MODULE ADDRESS
;
LXI B,0 ;ADDRESS FIELD FILLED-IN WHEN MODULE BUILT
JMP START
DB 'COPYRIGHT (C) 1978, DIGITAL RESEARCH '
SIGNON: DB 'DDT VERS '
DB VERSION/10+'0','.'
DB VERSION MOD 10 + '0','$'
START: LXI SP,STACK
PUSH B
PUSH B
LXI D,SIGNON
MVI C,PRNT
CALL BDOS
POP B ;RECOVER LENGTH OF MOVE
LXI H,BDOS+2;ADDRESS FIELD OF JUMP TO BDOS (TOP MEMORY)
MOV A,M ;A HAS HIGH ORDER ADDRESS OF MEMORY TOP
DCR A ;PAGE DIRECTLY BELOW BDOS
SUB B ;A HAS HIGH ORDER ADDRESS OF RELOC AREA
MOV D,A
MVI E,0 ;D,E ADDRESSES BASE OF RELOC AREA
PUSH D ;SAVE FOR RELOCATION BELOW
;
LXI H,MODULE;READY FOR THE MOVE
MOVE: MOV A,B ;BC=0?
ORA C
JZ RELOC
DCX B ;COUNT MODULE SIZE DOWN TO ZERO
MOV A,M ;GET NEXT ABSOLUTE LOCATION
STAX D ;PLACE IT INTO THE RELOC AREA
INX D
INX H
JMP MOVE
;
RELOC: ;STORAGE MOVED, READY FOR RELOCATION
; HL ADDRESSES BEGINNING OF THE BIT MAP FOR RELOCATION
POP D ;RECALL BASE OF RELOCATION AREA
POP B ;RECALL MODULE LENGTH
PUSH H ;SAVE BIT MAP BASE IN STACK
MOV H,D ;RELOCATION BIAS IS IN D
;
REL0: MOV A,B ;BC=0?
ORA C
JZ ENDREL
;
; NOT END OF THE RELOCATION, MAY BE INTO NEXT BYTE OF BIT MAP
DCX B ;COUNT LENGTH DOWN
MOV A,E
ANI 111B ;0 CAUSES FETCH OF NEXT BYTE
JNZ REL1
; FETCH BIT MAP FROM STACKED ADDRESS
XTHL
MOV A,M ;NEXT 8 BITS OF MAP
INX H
XTHL ;BASE ADDRESS GOES BACK TO STACK
MOV L,A ;L HOLDS THE MAP AS WE PROCESS 8 LOCATIONS
REL1: MOV A,L
RAL ;CY SET TO 1 IF RELOCATION NECESSARY
MOV L,A ;BACK TO L FOR NEXT TIME AROUND
JNC REL2 ;SKIP RELOCATION IF CY=0
;
; CURRENT ADDRESS REQUIRES RELOCATION
LDAX D
ADD H ;APPLY BIAS IN H
STAX D
REL2: INX D ;TO NEXT ADDRESS
JMP REL0 ;FOR ANOTHER BYTE TO RELOCATE
;
ENDREL: ;END OF RELOCATION
POP D ;CLEAR STACKED ADDRESS
MVI L,0
PCHL ;GO TO RELOCATED PROGRAM
END


1070
CPM OPERATING SYSTEMS/CPM 2.X/CPM 2.0/ddt1asm.asm Normal file
View File

File diff suppressed because it is too large Load Diff

1643
CPM OPERATING SYSTEMS/CPM 2.X/CPM 2.0/ddt2mon.asm Normal file
View File

File diff suppressed because it is too large Load Diff

379
CPM OPERATING SYSTEMS/CPM 2.X/CPM 2.0/deblock.asm Normal file
View File

@@ -0,0 +1,379 @@
;*****************************************************
;* *
;* Sector Deblocking Algorithms for CP/M 2.0 *
;* *
;*****************************************************
;
; utility macro to compute sector mask
smask macro hblk
;; compute log2(hblk), return @x as result
;; (2 ** @x = hblk on return)
@y set hblk
@x set 0
;; count right shifts of @y until = 1
rept 8
if @y = 1
exitm
endif
;; @y is not 1, shift right one position
@y set @y shr 1
@x set @x + 1
endm
endm
;
;*****************************************************
;* *
;* CP/M to host disk constants *
;* *
;*****************************************************
blksiz equ 2048 ;CP/M allocation size
hstsiz equ 512 ;host disk sector size
hstspt equ 20 ;host disk sectors/trk
hstblk equ hstsiz/128 ;CP/M sects/host buff
cpmspt equ hstblk * hstspt ;CP/M sectors/track
secmsk equ hstblk-1 ;sector mask
smask hstblk ;compute sector mask
secshf equ @x ;log2(hstblk)
;
;*****************************************************
;* *
;* BDOS constants on entry to write *
;* *
;*****************************************************
wrall equ 0 ;write to allocated
wrdir equ 1 ;write to directory
wrual equ 2 ;write to unallocated
;
;*****************************************************
;* *
;* The BDOS entry points given below show the *
;* code which is relevant to deblocking only. *
;* *
;*****************************************************
;
; DISKDEF macro, or hand coded tables go here
dpbase equ $ ;disk param block base
;
boot:
wboot:
;enter here on system boot to initialize
xra a ;0 to accumulator
sta hstact ;host buffer inactive
sta unacnt ;clear unalloc count
ret
;
seldsk:
;select disk
mov a,c ;selected disk number
sta sekdsk ;seek disk number
mov l,a ;disk number to HL
mvi h,0
rept 4 ;multiply by 16
dad h
endm
lxi d,dpbase ;base of parm block
dad d ;hl=.dpb(curdsk)
ret
;
settrk:
;set track given by registers BC
mov h,b
mov l,c
shld sektrk ;track to seek
ret
;
setsec:
;set sector given by register c
mov a,c
sta seksec ;sector to seek
ret
;
setdma:
;set dma address given by BC
mov h,b
mov l,c
shld dmaadr
ret
;
sectran:
;translate sector number BC
mov h,b
mov l,c
ret
;
;*****************************************************
;* *
;* The READ entry point takes the place of *
;* the previous BIOS defintion for READ. *
;* *
;*****************************************************
read:
;read the selected CP/M sector
xra a
sta unacnt
mvi a,1
sta readop ;read operation
sta rsflag ;must read data
mvi a,wrual
sta wrtype ;treat as unalloc
jmp rwoper ;to perform the read
;
;*****************************************************
;* *
;* The WRITE entry point takes the place of *
;* the previous BIOS defintion for WRITE. *
;* *
;*****************************************************
write:
;write the selected CP/M sector
xra a ;0 to accumulator
sta readop ;not a read operation
mov a,c ;write type in c
sta wrtype
cpi wrual ;write unallocated?
jnz chkuna ;check for unalloc
;
; write to unallocated, set parameters
mvi a,blksiz/128 ;next unalloc recs
sta unacnt
lda sekdsk ;disk to seek
sta unadsk ;unadsk = sekdsk
lhld sektrk
shld unatrk ;unatrk = sectrk
lda seksec
sta unasec ;unasec = seksec
;
chkuna:
;check for write to unallocated sector
lda unacnt ;any unalloc remain?
ora a
jz alloc ;skip if not
;
; more unallocated records remain
dcr a ;unacnt = unacnt-1
sta unacnt
lda sekdsk ;same disk?
lxi h,unadsk
cmp m ;sekdsk = unadsk?
jnz alloc ;skip if not
;
; disks are the same
lxi h,unatrk
call sektrkcmp ;sektrk = unatrk?
jnz alloc ;skip if not
;
; tracks are the same
lda seksec ;same sector?
lxi h,unasec
cmp m ;seksec = unasec?
jnz alloc ;skip if not
;
; match, move to next sector for future ref
inr m ;unasec = unasec+1
mov a,m ;end of track?
cpi cpmspt ;count CP/M sectors
jc noovf ;skip if no overflow
;
; overflow to next track
mvi m,0 ;unasec = 0
lhld unatrk
inx h
shld unatrk ;unatrk = unatrk+1
;
noovf:
;match found, mark as unnecessary read
xra a ;0 to accumulator
sta rsflag ;rsflag = 0
jmp rwoper ;to perform the write
;
alloc:
;not an unallocated record, requires pre-read
xra a ;0 to accum
sta unacnt ;unacnt = 0
inr a ;1 to accum
sta rsflag ;rsflag = 1
;
;*****************************************************
;* *
;* Common code for READ and WRITE follows *
;* *
;*****************************************************
rwoper:
;enter here to perform the read/write
xra a ;zero to accum
sta erflag ;no errors (yet)
lda seksec ;compute host sector
rept secshf
ora a ;carry = 0
rar ;shift right
endm
sta sekhst ;host sector to seek
;
; active host sector?
lxi h,hstact ;host active flag
mov a,m
mvi m,1 ;always becomes 1
ora a ;was it already?
jz filhst ;fill host if not
;
; host buffer active, same as seek buffer?
lda sekdsk
lxi h,hstdsk ;same disk?
cmp m ;sekdsk = hstdsk?
jnz nomatch
;
; same disk, same track?
lxi h,hsttrk
call sektrkcmp ;sektrk = hsttrk?
jnz nomatch
;
; same disk, same track, same buffer?
lda sekhst
lxi h,hstsec ;sekhst = hstsec?
cmp m
jz match ;skip if match
;
nomatch:
;proper disk, but not correct sector
lda hstwrt ;host written?
ora a
cnz writehst ;clear host buff
;
filhst:
;may have to fill the host buffer
lda sekdsk
sta hstdsk
lhld sektrk
shld hsttrk
lda sekhst
sta hstsec
lda rsflag ;need to read?
ora a
cnz readhst ;yes, if 1
xra a ;0 to accum
sta hstwrt ;no pending write
;
match:
;copy data to or from buffer
lda seksec ;mask buffer number
ani secmsk ;least signif bits
mov l,a ;ready to shift
mvi h,0 ;double count
rept 7 ;shift left 7
dad h
endm
; hl has relative host buffer address
lxi d,hstbuf
dad d ;hl = host address
xchg ;now in DE
lhld dmaadr ;get/put CP/M data
mvi c,128 ;length of move
lda readop ;which way?
ora a
jnz rwmove ;skip if read
;
; write operation, mark and switch direction
mvi a,1
sta hstwrt ;hstwrt = 1
xchg ;source/dest swap
;
rwmove:
;C initially 128, DE is source, HL is dest
ldax d ;source character
inx d
mov m,a ;to dest
inx h
dcr c ;loop 128 times
jnz rwmove
;
; data has been moved to/from host buffer
lda wrtype ;write type
cpi wrdir ;to directory?
lda erflag ;in case of errors
rnz ;no further processing
;
; clear host buffer for directory write
ora a ;errors?
rnz ;skip if so
xra a ;0 to accum
sta hstwrt ;buffer written
call writehst
lda erflag
ret
;
;*****************************************************
;* *
;* Utility subroutine for 16-bit compare *
;* *
;*****************************************************
sektrkcmp:
;HL = .unatrk or .hsttrk, compare with sektrk
xchg
lxi h,sektrk
ldax d ;low byte compare
cmp m ;same?
rnz ;return if not
; low bytes equal, test high 1s
inx d
inx h
ldax d
cmp m ;sets flags
ret
;
;*****************************************************
;* *
;* WRITEHST performs the physical write to *
;* the host disk, READHST reads the physical *
;* disk. *
;* *
;*****************************************************
writehst:
;hstdsk = host disk #, hsttrk = host track #,
;hstsec = host sect #. write "hstsiz" bytes
;from hstbuf and return error flag in erflag.
;return erflag non-zero if error
ret
;
readhst:
;hstdsk = host disk #, hsttrk = host track #,
;hstsec = host sect #. read "hstsiz" bytes
;into hstbuf and return error flag in erflag.
ret
;
;*****************************************************
;* *
;* Unitialized RAM data areas *
;* *
;*****************************************************
;
sekdsk: ds 1 ;seek disk number
sektrk: ds 2 ;seek track number
seksec: ds 1 ;seek sector number
;
hstdsk: ds 1 ;host disk number
hsttrk: ds 2 ;host track number
hstsec: ds 1 ;host sector number
;
sekhst: ds 1 ;seek shr secshf
hstact: ds 1 ;host active flag
hstwrt: ds 1 ;host written flag
;
unacnt: ds 1 ;unalloc rec cnt
unadsk: ds 1 ;last unalloc disk
unatrk: ds 2 ;last unalloc track
unasec: ds 1 ;last unalloc sector
;
erflag: ds 1 ;error reporting
rsflag: ds 1 ;read sector flag
readop: ds 1 ;1 if read operation
wrtype: ds 1 ;write operation type
dmaadr: ds 2 ;last dma address
hstbuf: ds hstsiz ;host buffer
;
;*****************************************************
;* *
;* The ENDEF macro invocation goes here *
;* *
;*****************************************************
end


219
CPM OPERATING SYSTEMS/CPM 2.X/CPM 2.0/ed.lin Normal file
View File

@@ -0,0 +1,219 @@
0000 ED#
0000 ED#
0AF3 17 0AF3 18 0AFC 19 0AFC 22 0B00 24
0B07 25 0B08 26 0B13 27 0B14 29 0B18 31
0B20 32 0B24 33 0B2C 34 0B31 35 0B38 36
0B39 37 0B39 38 0B41 39 0B42 40 0B47 41
0B4C 42 0B51 43 0B56 44 0B57 45 0B5B 47
0B73 48 0B78 49 0B7D 50 0B8C 51 0B93 52
0B9A 53 0B9B 54 0B9F 56 0BA7 57 0BAA 58
0BCB 59 0BCB 60 0BCF 62 0BDA 64 0BDF 65
0BE7 66 0BE7 67 0BEE 68 0BEF 69 0BEF 70
0BF4 71 0BF9 72 0BFA 73 0C00 75 0C09 76
0C0A 77 0C10 79 0C13 80 0C1B 81 0C1C 82
0C22 84 0C2B 85 0C2C 87 0C32 89 0C3E 90
0C3F 91 0C45 93 0C51 94 0C52 95 0C58 97
0C64 98 0C65 99 0C6B 101 0C74 102 0C75 103
0C7B 105 0C85 106 0C85 107 0C8B 109 0C95 110
0C95 111 0C9B 113 0CA7 114 0CA8 115 0CAE 117
0CB7 118 0CB8 120 0CB8 121 0CBD 122 0CC3 123
0CC4 124 0CC4 125 0CD0 127 0CD8 128 0CDB 129
0CDB 130 0CDE 131 0CDE 132 0CDE 133 0CE7 134
0CE7 135 0CEB 137 0CF6 138 0CF7 139 0CFD 141
0D06 142 0D07 143 0D07 144 0D0E 145 0D14 146
0D17 147 0D18 149 0D1E 151 0D26 152 0D29 153
0D2C 154 0D2D 155 0D2D 156 0D33 157 0D39 158
0D3A 159 0D40 161 0D54 162 0D55 163 0D55 164
0D5B 165 0D61 166 0D70 167 0D80 168 0D8A 170
0D91 171 0D97 172 0D9F 173 0DA5 174 0DA5 175
0DAC 176 0DB2 177 0DBA 179 0DC0 180 0DC8 181
0DCB 182 0DD1 183 0DD4 184 0DD7 185 0DDF 187
0DE5 188 0DE8 189 0DEB 190 0DF3 191 0DF9 192
0DFF 193 0E05 194 0E0F 196 0E16 197 0E1C 198
0E1C 199 0E22 200 0E28 201 0E2E 202 0E33 203
0E3B 204 0E3E 205 0E44 206 0E45 207 0E45 208
0E59 209 0E5A 210 0E5A 211 0E61 212 0E67 213
0E68 214 0ED3 216 0ED3 217 0ED9 218 0E68 219
0E6B 220 0E72 221 0E81 222 0E8E 223 0E9C 225
0EA5 226 0EA8 227 0EB2 228 0EB8 229 0EBB 230
0EC5 231 0ECF 232 0ED2 233 0EDA 234 0EDA 236
0EE6 237 0EE9 238 0EFA 239 0F01 240 0F05 241
0F05 242 0F66 244 0F66 245 0F6C 246 0F05 247
0F0C 248 0F20 249 0F21 250 0F24 251 0F33 252
0F40 253 0F4B 254 0F4E 255 0F58 256 0F62 257
0F65 258 0F6D 259 0F71 261 0F7D 262 0F80 263
0F8C 264 0F93 265 0F94 266 0F98 268 0FA0 270
0FA3 271 0FAE 272 0FB1 273 0FB6 274 0FB6 275
0FC3 276 0FCA 277 0FCB 278 103B 279 103B 280
104B 281 0FCB 282 0FD0 283 0FDB 284 0FE2 285
0FE7 286 0FEA 287 0FED 288 0FF3 289 0FFB 290
0FFE 291 1004 292 1007 293 100E 294 101E 295
1024 296 1027 297 102D 298 1034 299 103A 300
104C 306 1050 308 1058 309 1059 310 1060 311
1061 313 1065 315 1079 316 1079 317 107D 319
1088 320 108E 321 1092 322 1092 323 1096 325
109D 326 10A5 327 10A9 328 10A9 329 10AF 331
10B5 332 10BA 333 10C6 334 10D4 335 10E1 336
10EF 337 10FF 339 1104 340 110D 341 1110 342
1115 343 1118 344 1119 345 111F 347 1127 348
1128 349 1130 350 1135 351 113A 352 1141 353
1149 354 114E 355 114F 356 114F 357 1157 358
1158 359 1158 360 1160 361 1161 362 1164 363
1165 364 1165 365 116E 367 1175 368 1178 369
1182 371 118E 373 119E 374 11A1 375 11A1 376
11A6 377 11A6 378 11BA 379 11BA 380 11C1 381
11C9 382 11D0 384 11D5 385 11E5 387 11F1 388
11FA 389 11FD 390 1200 391 1205 392 1208 393
120D 394 1212 395 1217 396 1217 397 1228 398
1233 399 1247 400 1247 401 1247 402 124E 403
1254 404 1255 405 1255 406 125D 408 1260 409
126B 410 126E 411 1273 412 1273 413 1287 414
1287 416 1287 417 128D 418 128E 419 128E 420
129B 421 129B 422 129B 423 12A1 424 12A2 425
12A2 426 12AA 428 12B1 429 12B4 430 12B4 431
12B7 432 12B7 433 12B7 435 12BD 436 12C5 438
12CC 439 12D2 440 12D8 441 12DC 442 12DF 444
12E5 445 12EB 446 12F1 447 12F1 448 12F6 449
12FD 450 132A 451 1330 452 1333 453 133A 454
134D 455 1355 457 135A 458 1368 459 136B 460
1372 461 1378 462 137B 463 1383 465 1389 466
1390 467 1393 469 139A 470 13A1 471 13A1 472
13A2 473 13A2 474 13A9 475 13AA 476 13AA 477
13B1 478 13B2 479 13B2 480 13B9 481 13BA 482
13BA 483 13C1 484 13C2 485 13C2 486 13C9 487
13CA 488 13CE 490 13D6 491 13E2 492 13E5 493
13EC 495 13FC 496 13FF 497 140A 498 140D 499
140D 500 1413 501 141F 502 1422 503 1432 504
1439 505 1440 507 144B 508 144E 509 144E 510
1451 511 1452 512 1452 513 1457 514 1458 515
1458 516 145D 517 145E 518 145E 519 1461 520
1464 521 1465 522 1465 523 146D 525 1473 526
147F 527 1488 528 1494 529 1497 531 149D 532
14AF 533 14B8 534 14C3 535 14C3 536 14C4 537
1504 539 1508 541 150F 542 1517 543 151B 544
14C4 545 14C4 546 14D0 547 14D3 548 14E2 550
14E5 551 14E6 552 14E6 553 14F1 554 14F4 555
14FC 557 14FF 558 1500 559 1500 560 1503 561
151B 562 151B 564 151B 565 1527 567 152A 568
152B 569 152B 570 152E 571 153D 572 1545 574
1548 575 1549 576 1549 577 154C 578 154D 579
154D 580 1550 581 1557 582 1569 583 156F 584
1572 585 1575 586 1576 587 1576 588 157B 589
1581 590 1587 591 158A 592 1591 593 1594 594
159B 595 159E 596 15A1 597 15AD 599 15B2 600
15B5 601 15B5 602 15B6 603 15B6 604 15B9 605
15BC 606 15BD 607 15BD 608 15C0 609 15CB 610
15D2 611 15D5 612 15D8 613 15D9 614 15D9 615
15E6 616 15E9 617 15F4 618 15F7 619 15FF 620
1602 621 1603 622 1603 623 1624 624 1624 625
1652 626 1652 627 165F 628 166B 629 166E 630
1624 631 162B 632 1633 634 1638 635 163B 636
1640 637 1640 638 1648 639 164B 640 164E 641
1651 642 166F 643 1675 646 167B 647 1680 648
1696 649 16A0 650 16A6 651 16D3 652 16DA 653
16E1 654 16E4 655 16E7 656 16EE 658 16F5 659
16F8 660 16F8 661 16FC 662 16FC 663 16FC 664
1701 665 1704 666 170A 667 170B 668 170B 669
1719 670 171C 671 171D 672 171D 673 1737 674
1738 675 1738 676 1745 677 1746 678 1746 681
1749 682 174E 683 1756 685 175C 686 1762 687
1765 688 176B 689 178C 690 178F 691 17A1 692
17A9 694 17AC 695 17B3 696 17BA 697 17BD 698
17BD 699 17CC 700 17D9 701 17DA 702 17DA 703
17E0 704 17E1 705 17E1 706 17E7 707 17E8 708
17E8 709 17EE 710 17EF 711 17EF 713 17F2 714
17F5 715 17F8 716 17FE 717 1803 718 1806 719
1809 720 180F 721 1830 722 1836 723 1839 724
183A 725 183A 727 1848 728 184F 729 1852 730
1857 731 1861 732 1862 733 1862 734 1867 735
186D 736 186E 737 186E 738 1871 739 1878 740
1884 741 188A 742 188D 743 1890 744 1891 745
1891 746 1896 747 1899 748 189E 749 18A1 750
18A2 751 18A2 753 18A7 754 18B1 755 18BB 756
18C5 757 18C6 758 18C6 759 18CB 760 18D1 761
18D4 762 18D5 763 18D9 765 18FC 766 18FC 767
1900 769 190B 771 190E 772 1915 773 191D 774
1927 775 192A 776 1932 777 1935 778 1938 779
1938 780 193B 781 01C0 782 01DA 783 01E9 784
01F9 786 01FF 787 0202 788 0202 789 0211 790
021E 791 022A 792 0236 793 023F 794 0246 795
0253 796 025D 797 0262 798 027A 799 027D 800
0288 801 0291 803 0298 804 029D 805 029D 806
02A8 807 02B1 808 02B8 809 02BB 810 02BE 811
02C3 812 02C9 813 02CF 814 02D4 815 02D7 816
02DF 817 02E2 818 02EA 819 02ED 820 02F5 821
02FD 822 0303 823 030A 824 0310 825 0317 826
031A 827 0322 828 0327 829 0327 830 032C 831
032F 832 0335 833 033E 835 0341 836 034B 837
035C 838 035F 839 0362 840 036B 842 036E 843
0374 844 037A 845 0380 846 0383 847 0386 848
038E 850 03AB 851 03AE 852 03B4 853 03BB 854
03C3 855 03E7 857 03ED 858 03F2 859 03F9 861
03FC 862 03FF 863 0402 865 0405 866 0408 867
0410 869 0413 870 0416 871 0419 872 0423 873
0426 874 0429 875 0429 876 042C 877 0434 879
0441 880 0446 881 045F 883 046D 885 0470 886
0475 887 047A 888 0480 889 0485 890 0488 891
048D 892 049A 893 04A0 894 04A6 895 04B0 896
04B3 897 04B6 898 04BC 899 04BC 900 04BC 901
04C1 902 04C7 903 04CA 904 04D2 906 04DE 907
04E1 908 04E4 909 04F3 910 04FB 911 0502 912
0507 913 050A 915 0516 917 051B 918 0524 919
0524 920 052C 921 0532 923 053A 925 0542 926
054C 927 0554 928 0562 929 0562 930 0565 931
0565 932 0565 933 056D 934 0570 935 0578 936
0585 937 058A 938 058D 939 0590 940 0598 941
059B 942 05A6 943 05A9 944 05AC 945 05B5 946
05B8 947 05C0 950 05C5 951 05C8 952 05CF 953
05D8 954 05DB 955 05DE 956 05E1 957 05E6 958
05F5 960 0605 961 060B 962 060E 963 0617 964
061A 965 061D 966 0627 967 062D 968 0632 969
063A 971 063F 972 0642 973 0642 974 064D 975
0650 976 0653 977 0658 978 065F 979 0669 980
0676 981 067D 982 0680 983 0683 984 0686 985
068F 987 0695 988 0698 989 193B 992 193B 993
194A 994 194A 995 194A 996 1950 997 1957 998
196F 999 1972 1000 1975 1001 1976 1002 1976 1003
1982 1005 1987 1006 1995 1007 1998 1009 199D 1010
19A9 1011 19A9 1012 069B 1013 069E 1014 06A6 1016
06A9 1017 06AE 1018 06AE 1019 06B6 1021 06B9 1022
06BC 1023 06BF 1024 06C6 1026 06C9 1027 06D1 1029
06D6 1030 06D9 1031 06D9 1032 06DC 1033 06E4 1035
06E7 1036 06EA 1037 06ED 1038 06F5 1039 06FC 1040
06FC 1041 0703 1042 0708 1043 0710 1045 0717 1046
071D 1047 0723 1048 0726 1049 0729 1050 0731 1052
0734 1053 0737 1054 073A 1055 0742 1057 0745 1058
0748 1059 074B 1060 0753 1062 0756 1063 0759 1064
075C 1065 0764 1066 076A 1067 0772 1069 0779 1071
077E 1072 0781 1073 0784 1074 0787 1075 078E 1076
0791 1077 0794 1078 0797 1079 079A 1080 07A2 1081
07A8 1082 07B0 1083 07BE 1084 07C6 1086 07CD 1088
07DB 1089 07E0 1090 07E8 1091 07EB 1092 07EE 1093
07F9 1094 07FC 1095 0804 1097 081C 1099 081F 1100
0822 1101 0825 1102 0825 1103 0828 1104 083B 1106
0843 1108 0848 1109 084E 1110 0854 1111 0857 1112
085E 1113 0861 1114 0868 1115 086B 1116 086E 1117
0873 1118 0876 1119 0879 1120 0881 1122 0884 1123
088B 1124 088E 1125 0891 1126 0894 1127 089C 1130
089F 1131 08A2 1132 08A8 1133 08AB 1134 08B2 1135
08B5 1136 08BC 1137 08CA 1138 08D7 1139 08DA 1140
08DD 1141 08E3 1142 08F3 1143 08F6 1144 0906 1145
090B 1146 090E 1147 0914 1148 0917 1149 091A 1150
0932 1152 0937 1153 0943 1154 0946 1155 0961 1156
0964 1157 096A 1158 096F 1159 0979 1160 097C 1161
0984 1163 0987 1164 098E 1165 099C 1166 09A3 1167
09A6 1168 09A9 1169 09AC 1170 09AF 1171 09B4 1172
09BA 1173 09BD 1174 09C0 1175 09C5 1176 09D1 1177
09D4 1178 09D7 1179 09DA 1180 09DD 1181 09E5 1183
09E8 1184 09EB 1185 09F2 1186 09F5 1187 0A06 1188
0A10 1189 0A1D 1190 0A24 1191 0A27 1192 0A2A 1193
0A2D 1194 0A30 1195 0A38 1196 0A3E 1197 0A46 1199
0A49 1200 0A50 1202 0A53 1203 0A59 1204 0A5C 1207
0A64 1209 0A67 1210 0A6C 1211 0A72 1212 0A78 1213
0A80 1214 0A83 1215 0A83 1216 0A86 1217 0A98 1218
0AA3 1219 0AB0 1220 0AB0 1221 0AB3 1222 0ABB 1224
0AC2 1226 0ACA 1227 0ACD 1228 0ACD 1229 0AD4 1230
0AD7 1231 0ADA 1232 0ADD 1233 0AE5 1234 0AE8 1235
0AEB 1236 0AEE 1237 0AEE 1238 0AF1 1239
0000 MODULE#

1630
CPM OPERATING SYSTEMS/CPM 2.X/CPM 2.0/ed.plm Normal file
View File

File diff suppressed because it is too large Load Diff

106
CPM OPERATING SYSTEMS/CPM 2.X/CPM 2.0/ed20pat.asm Normal file
View File

@@ -0,0 +1,106 @@
; assembly language version of mem$move for ed speedup
; version 2.0 of ED
;
mem$move equ 13cah
moveflag equ 1d34h
direction equ 1d20h
front equ 1d22h
back equ 1d24h
first equ 1d26h
last equ 1d28h
baseline equ 1c10h
memory equ 1d4dh
;
forward equ 1
lf equ 0ah
;
org mem$move
lxi h,moveflag
mov m,c ;1 = move data
lxi d,memory
lhld front
dad d ;memory+front
push h
lhld back
dad d
push h
lda direction
cpi forward
jnz moveback
lhld last
mov a,c ;moveflag to a
rar
jc moveforw
; set back to last
shld back
pop h
pop h
ret
;
moveforw:
dad d ;memory+last
mov b,h
mov c,l
pop h
pop d ;bc=last, de=front, hl=back
movef: mov a,l ;back < last?
sub c
mov a,h
sbb b ;cy if true
jnc emove
inx h ;back=back+1
mov a,m ;char to a
cpi lf ;end of line?
jnz notlff
push h
lhld baseline
inx h ;baseline=baseline+1
shld baseline
pop h
notlff:
stax d ;to front
inx d ;front=front+1
jmp movef
moveback:
lhld first
dad d ;memory+first
mov b,h
mov c,l
pop h
pop d ;bc=first, de=front, hl=last
moveb: mov a,c ;first > front?
sub e
mov a,b
sbb d ;cy if true
jnc emove
dcx d ;front=front-1
ldax d ;char to a
cpi lf
jnz notlfb
push h
lhld baseline
dcx h ;baseline=baseline-1
shld baseline
pop h
notlfb: push psw ;save char
lda moveflag
rar
jnc nomove
pop psw
mov m,a ;store to back
dcx h
jmp moveb
nomove: pop psw
jmp moveb
;
emove: push d
lxi d,-memory
dad d ;relative value of back
shld back
pop h
dad d ;relative value of front
shld front
ret
end


47
CPM OPERATING SYSTEMS/CPM 2.X/CPM 2.0/load.lin Normal file
View File

@@ -0,0 +1,47 @@
0000 LOAD#
0000 LOAD#
023B 13 023B 14 023F 15 0240 16 0240 17
02D0 22 02D4 24 02DF 25 02E0 26 02E0 27
02E5 28 02EA 29 02EB 30 02EF 32 02F8 33
0306 34 030F 35 0310 36 0314 38 0321 39
032A 40 032B 41 0331 43 0339 44 0341 45
0342 46 0348 48 0351 49 0352 50 0358 52
035B 53 0363 54 0364 56 036A 58 0370 59
0378 60 037E 61 0386 62 0389 63 038A 65
0390 67 039C 68 039D 69 03A3 71 03AF 72
03B0 73 03B6 75 03C2 76 03C3 77 03C3 78
03CE 79 03CF 80 03D5 82 03DE 83 03DF 84
03E5 86 03EF 87 03EF 88 03F5 90 03FF 91
03FF 92 0405 94 0411 95 0412 96 0418 98
0421 99 0422 100 0431 102 043D 103 0447 104
044E 105 0455 106 0458 107 0459 108 0459 110
0469 111 0472 112 0497 113 04A5 114 04BA 116
04C2 117 04C8 118 04D1 119 04D7 120 04D7 121
04DA 122 04E0 123 04E4 124 04E4 126 05FD 129
0601 131 060D 132 0613 133 0624 134 0632 135
064A 136 0651 137 0658 138 065C 139 0667 141
066D 142 066D 143 0670 144 067F 145 0680 146
06E6 148 06E6 149 06E9 150 06F1 151 06F6 152
06FB 153 0680 154 0686 155 068E 156 0694 157
069C 158 06A2 159 06A5 160 06B1 161 06BC 162
06BF 163 06D0 164 06D7 165 06DC 166 06DF 167
06E2 168 06E5 169 06FC 170 06FC 172 070B 173
0711 174 071D 176 0723 177 0726 178 0726 179
072E 180 072E 181 072E 182 073D 183 073D 184
073D 186 0748 187 074C 188 074C 189 0752 191
0763 192 04E4 193 04F0 194 04F4 195 04FD 196
0502 197 0502 198 050A 199 050D 200 0512 201
051D 202 0520 203 052E 204 0541 205 054D 206
0553 207 0559 208 0565 209 056C 210 0573 211
0576 212 0582 213 0589 214 0595 216 059B 217
059E 218 059E 219 05A1 220 05A7 221 05B3 222
05B8 223 05BF 224 05C2 225 05C8 226 05D0 227
05D6 228 05DE 229 05E4 230 05EC 231 05F2 232
05F9 233 05FC 234 0240 236 0247 237 024B 238
0251 239 0257 240 0263 241 026F 242 0275 243
027D 244 0283 245 028F 246 0295 247 029B 248
02A1 249 02A9 250 02B2 252 02B5 253 02BB 254
02C3 255 02C9 256 02C9 257 02CC 258 02CF 259
0000 MODULE#


360
CPM OPERATING SYSTEMS/CPM 2.X/CPM 2.0/load.plm Normal file
View File

@@ -0,0 +1,360 @@
LOAD:
DO;
/* C P / M C O M M A N D F I L E L O A D E R
COPYRIGHT (C) 1976, 1977, 1978
DIGITAL RESEARCH
BOX 579 PACIFIC GROVE
CALIFORNIA 93950
*/
DECLARE
TPA LITERALLY '0100H', /* TRANSIENT PROGRAM AREA */
DFCBA LITERALLY '005CH', /* DEFAULT FILE CONTROL BLOCK */
DBUFF LITERALLY '0080H'; /* DEFAULT BUFFER ADDRESS */
/* JMP LOADCOM TO START LOAD */
DECLARE JUMP BYTE DATA(0C3H);
DECLARE JUMPA ADDRESS DATA(.LOADCOM);
DECLARE COPYRIGHT(*) BYTE DATA
(' COPYRIGHT (C) 1978, DIGITAL RESEARCH ');
MON1: PROCEDURE(F,A) EXTERNAL;
DECLARE F BYTE, A ADDRESS;
END MON1;
MON2: PROCEDURE(F,A) BYTE EXTERNAL;
DECLARE F BYTE, A ADDRESS;
END MON2;
DECLARE SP ADDRESS;
BOOT: PROCEDURE;
STACKPTR = SP;
RETURN;
END BOOT;
LOADCOM: PROCEDURE;
DECLARE FCB (33) BYTE AT (DFCBA),
FCBA LITERALLY 'DFCBA';
DECLARE BUFFER (128) BYTE AT (DBUFF),
BUFFA LITERALLY 'DBUFF';
DECLARE SFCB(33) BYTE, /* SOURCE FILE CONTROL BLOCK */
BSIZE LITERALLY '1024',
EOFILE LITERALLY '1AH',
SBUFF(BSIZE) BYTE, /* SOURCE FILE BUFFER */
RFLAG BYTE, /* READER FLAG */
SBP ADDRESS; /* SOURCE FILE BUFFER POINTER */
/* LOADCOM LOADS TRANSIENT COMMAND FILES TO THE DISK FROM THE
CURRENTLY DEFINED READER PERIPHERAL. THE LOADER PLACES THE MACHINE
CODE INTO A FILE WHICH APPEARS IN THE LOADCOM COMMAND */
DECLARE
TRUE LITERALLY '1',
FALSE LITERALLY '0',
FOREVER LITERALLY 'WHILE TRUE',
CR LITERALLY '13',
LF LITERALLY '10',
WHAT LITERALLY '63';
PRINTCHAR: PROCEDURE(CHAR);
DECLARE CHAR BYTE;
CALL MON1(2,CHAR);
END PRINTCHAR;
CRLF: PROCEDURE;
CALL PRINTCHAR(CR);
CALL PRINTCHAR(LF);
END CRLF;
PRINTNIB: PROCEDURE(N);
DECLARE N BYTE;
IF N > 9 THEN CALL PRINTCHAR(N+'A'-10); ELSE
CALL PRINTCHAR(N+'0');
END PRINTNIB;
PRINTHEX: PROCEDURE(B);
DECLARE B BYTE;
CALL PRINTNIB(SHR(B,4)); CALL PRINTNIB(B AND 0FH);
END PRINTHEX;
PRINTADDR: PROCEDURE(A);
DECLARE A ADDRESS;
CALL PRINTHEX(HIGH(A)); CALL PRINTHEX(LOW(A));
END PRINTADDR;
PRINTM: PROCEDURE(A);
DECLARE A ADDRESS;
CALL MON1(9,A);
END PRINTM;
PRINT: PROCEDURE(A);
DECLARE A ADDRESS;
/* PRINT THE STRING STARTING AT ADDRESS A UNTIL THE
NEXT DOLLAR SIGN IS ENCOUNTERED WITH PRECEDING CRLF */
CALL CRLF;
CALL PRINTM(A);
END PRINT;
DECLARE LA ADDRESS; /* CURRENT LOAD ADDRESS */
PERROR: PROCEDURE(A);
/* PRINT ERROR MESSAGE */
DECLARE A ADDRESS;
CALL PRINT(.('ERROR: $'));
CALL PRINTM(A);
CALL PRINTM(.(', LOAD ADDRESS $'));
CALL PRINTADDR(LA);
CALL BOOT;
END PERROR;
DECLARE DCNT BYTE;
OPEN: PROCEDURE(FCB);
DECLARE FCB ADDRESS;
DCNT = MON2(15,FCB);
END OPEN;
CLOSE: PROCEDURE(FCB);
DECLARE FCB ADDRESS;
DCNT = MON2(16,FCB);
END CLOSE;
SEARCH: PROCEDURE(FCB);
DECLARE FCB ADDRESS;
DCNT = MON2(17,FCB);
END SEARCH;
SEARCHN: PROCEDURE;
DCNT = MON2(18,0);
END SEARCHN;
DELETE: PROCEDURE(FCB);
DECLARE FCB ADDRESS;
CALL MON1(19,FCB);
END DELETE;
DISKREAD: PROCEDURE(FCB) BYTE;
DECLARE FCB ADDRESS;
RETURN MON2(20,FCB);
END DISKREAD;
DISKWRITE: PROCEDURE(FCB) BYTE;
DECLARE FCB ADDRESS;
RETURN MON2(21,FCB);
END DISKWRITE;
MAKE: PROCEDURE(FCB);
DECLARE FCB ADDRESS;
DCNT = MON2(22,FCB);
END MAKE;
RENAME: PROCEDURE(FCB);
DECLARE FCB ADDRESS;
CALL MON1(23,FCB);
END RENAME;
MOVE: PROCEDURE(S,D,N);
DECLARE (S,D) ADDRESS, N BYTE,
A BASED S BYTE, B BASED D BYTE;
DO WHILE (N:=N-1) <> 255;
B = A; S=S+1; D=D+1;
END;
END MOVE;
GETCHAR: PROCEDURE BYTE;
/* GET NEXT CHARACTER */
DECLARE I BYTE;
IF (SBP := SBP+1) <= LAST(SBUFF) THEN
RETURN SBUFF(SBP);
/* OTHERWISE READ ANOTHER BUFFER FULL */
DO SBP = 0 TO LAST(SBUFF) BY 128;
IF (I:=DISKREAD(.SFCB)) = 0 THEN
CALL MOVE(80H,.SBUFF(SBP),80H); ELSE
DO;
IF I<>1 THEN CALL PERROR(.('DISK READ$'));
SBUFF(SBP) = EOFILE;
SBP = LAST(SBUFF);
END;
END;
SBP = 0; RETURN SBUFF(0);
END GETCHAR;
DECLARE
STACKPOINTER LITERALLY 'STACKPTR';
/* INTEL HEX FORMAT LOADER */
RELOC: PROCEDURE;
DECLARE (RL, CS, RT) BYTE;
DECLARE
TA ADDRESS, /* TEMP ADDRESS */
SA ADDRESS, /* START ADDRESS */
FA ADDRESS, /* FINAL ADDRESS */
NB ADDRESS, /* NUMBER OF BYTES LOADED */
MBUFF(256) BYTE,
P BYTE,
L ADDRESS;
SETMEM: PROCEDURE(B);
/* SET MBUFF TO B AT LOCATION LA MOD LENGTH(MBUFF) */
DECLARE (B,I) BYTE;
IF LA < L THEN
CALL PERROR(.('INVERTED LOAD ADDRESS$'));
DO WHILE LA > L + LAST(MBUFF); /* WRITE A PARAGRAPH */
DO I = 0 TO 127; /* COPY INTO BUFFER */
BUFFER(I) = MBUFF(LOW(L)); L = L + 1;
END;
/* WRITE BUFFER ONTO DISK */
P = P + 1;
IF DISKWRITE(FCBA) <> 0 THEN
DO; CALL PERROR(.('DISK WRITE$'));
END;
END;
MBUFF(LOW(LA)) = B;
END SETMEM;
DIAGNOSE: PROCEDURE;
DECLARE M BASED TA BYTE;
NEWLINE: PROCEDURE;
CALL CRLF; CALL PRINTADDR(TA); CALL PRINTCHAR(':');
CALL PRINTCHAR(' ');
END NEWLINE;
/* PRINT DIAGNOSTIC INFORMATION AT THE CONSOLE */
CALL PRINT(.('LOAD ADDRESS $')); CALL PRINTADDR(TA);
CALL PRINT(.('ERROR ADDRESS $')); CALL PRINTADDR(LA);
CALL PRINT(.('BYTES READ:$')); CALL NEWLINE;
DO WHILE TA < LA;
IF (LOW(TA) AND 0FH) = 0 THEN CALL NEWLINE;
CALL PRINTHEX(MBUFF(TA-L)); TA=TA+1;
CALL PRINTCHAR(' ');
END;
CALL CRLF;
CALL BOOT;
END DIAGNOSE;
READHEX: PROCEDURE BYTE;
/* READ ONE HEX CHARACTER FROM THE INPUT */
DECLARE H BYTE;
IF (H := GETCHAR) - '0' <= 9 THEN RETURN H - '0';
IF H - 'A' > 5 THEN
DO; CALL PRINT(.('INVALID HEX DIGIT$'));
CALL DIAGNOSE;
END;
RETURN H - 'A' + 10;
END READHEX;
READBYTE: PROCEDURE BYTE;
/* READ TWO HEX DIGITS */
RETURN SHL(READHEX,4) OR READHEX;
END READBYTE;
READCS: PROCEDURE BYTE;
/* READ BYTE WHILE COMPUTING CHECKSUM */
DECLARE B BYTE;
CS = CS + (B := READBYTE);
RETURN B;
END READCS;
MAKE$DOUBLE: PROCEDURE(H,L) ADDRESS;
/* CREATE A BOUBLE BYTE VALUE FROM TWO SINGLE BYTES */
DECLARE (H,L) BYTE;
RETURN SHL(DOUBLE(H),8) OR L;
END MAKE$DOUBLE;
/* INITIALIZE */
SA, FA, NB = 0;
P = 0; /* PARAGRAPH COUNT */
TA,L = TPA; /* BASE ADDRESS OF TRANSIENT ROUTINES */
SBUFF(0) = EOFILE;
/* READ RECORDS UNTIL :00XXXX IS ENCOUNTERED */
DO FOREVER;
/* SCAN THE : */
DO WHILE GETCHAR <> ':';
END;
/* SET CHECK SUM TO ZERO, AND SAVE THE RECORD LENGTH */
CS = 0;
/* MAY BE THE END OF TAPE */
IF (RL := READCS) = 0 THEN
GO TO FIN;
NB = NB + RL;
TA, LA = MAKE$DOUBLE(READCS,READCS);
IF SA = 0 THEN SA = LA;
/* READ THE RECORD TYPE (NOT CURRENTLY USED) */
RT = READCS;
/* PROCESS EACH BYTE */
DO WHILE (RL := RL - 1) <> 255;
CALL SETMEM(READCS); LA = LA+1;
END;
IF LA > FA THEN FA = LA - 1;
/* NOW READ CHECKSUM AND COMPARE */
IF CS + READBYTE <> 0 THEN
DO; CALL PRINT(.('CHECK SUM ERROR $'));
CALL DIAGNOSE;
END;
END;
FIN:
/* EMPTY THE BUFFERS */
TA = LA;
DO WHILE L < TA;
CALL SETMEM(0); LA = LA+1;
END;
/* PRINT FINAL STATISTICS */
CALL PRINT(.('FIRST ADDRESS $')); CALL PRINTADDR(SA);
CALL PRINT(.('LAST ADDRESS $')); CALL PRINTADDR(FA);
CALL PRINT(.('BYTES READ $')); CALL PRINTADDR(NB);
CALL PRINT(.('RECORDS WRITTEN $')); CALL PRINTHEX(P);
CALL CRLF;
END RELOC;
/* ARRIVE HERE FROM THE SYSTEM MONITOR, READY TO READ THE HEX TAPE */
/* SET UP STACKPOINTER IN THE LOCAL AREA */
DECLARE STACK(16) ADDRESS;
SP = STACKPOINTER; STACKPOINTER = .STACK(LENGTH(STACK));
LA = TPA;
SBP = LENGTH(SBUFF);
/* SET UP THE SOURCE FILE */
CALL MOVE(FCBA,.SFCB,33);
CALL MOVE(.('HEX',0),.SFCB(9),4);
CALL OPEN(.SFCB);
IF DCNT = 255 THEN CALL PERROR(.('CANNOT OPEN SOURCE$'));
CALL MOVE(.('COM'),FCBA+9,3);
/* REMOVE ANY EXISTING FILE BY THIS NAME */
CALL DELETE(FCBA);
/* THEN OPEN A NEW FILE */
CALL MAKE(FCBA); CALL OPEN(FCBA);
IF DCNT = 255 THEN CALL PERROR(.('NO MORE DIRECTORY SPACE$')); ELSE
DO; CALL RELOC;
CALL CLOSE(FCBA);
IF DCNT = 255 THEN CALL PERROR(.('CANNOT CLOSE FILE$'));
END;
CALL CRLF;
CALL BOOT;
END LOADCOM;
END;


16
CPM OPERATING SYSTEMS/CPM 2.X/CPM 2.0/mov20pat.asm Normal file
View File

@@ -0,0 +1,16 @@
; movcpm patch for cp/m 2.0 10/4/79
;
; the BDOS system reset function, number 0,
; previously executed a cold start, rather
; than a warm start.
;
; assembly language source change:
; 0844 DW WBOOTF, FUNC1, FUNC2, FUNC3
;
; assembly language patch
bias equ 0a00h ;bias within movcpm
wbootf equ 1603h ;relative wbootf addr
org 0844h+bias
dw wbootf
end


127
CPM OPERATING SYSTEMS/CPM 2.X/CPM 2.0/os1boot.asm Normal file
View File

@@ -0,0 +1,127 @@
title 'mds cold start loader at 3000h'
;
; MDS-800 Cold Start Loader for CP/M 2.0
;
; Version 2.0 August, 1979
;
false equ 0
true equ not false
testing equ false ;if true, then go to mon80 on errors
;
if testing
bias equ 03400h
endif
if not testing
bias equ 0000h
endif
cpmb equ bias ;base of dos load
bdos equ 806h+bias ;entry to dos for calls
bdose equ 1880h+bias ;end of dos load
boot equ 1600h+bias ;cold start entry point
rboot equ boot+3 ;warm start entry point
;
org 03000h ;loaded down from hardware boot at 3000h
;
bdosl equ bdose-cpmb
ntrks equ 2 ;number of tracks to read
bdoss equ bdosl/128 ;number of sectors in dos
bdos0 equ 25 ;number of bdos sectors on track 0
bdos1 equ bdoss-bdos0 ;number of sectors on track 1
;
mon80 equ 0f800h ;intel monitor base
rmon80 equ 0ff0fh ;restart location for mon80
base equ 078h ;'base' used by controller
rtype equ base+1 ;result type
rbyte equ base+3 ;result byte
reset equ base+7 ;reset controller
;
dstat equ base ;disk status port
ilow equ base+1 ;low iopb address
ihigh equ base+2 ;high iopb address
bsw equ 0ffh ;boot switch
recal equ 3h ;recalibrate selected drive
readf equ 4h ;disk read function
stack equ 100h ;use end of boot for stack
;
rstart:
lxi sp,stack;in case of call to mon80
; clear disk status
in rtype
in rbyte
; check if boot switch is off
coldstart:
in bsw
ani 02h ;switch on?
jnz coldstart
; clear the controller
out reset ;logic cleared
;
;
mvi b,ntrks ;number of tracks to read
lxi h,iopb0
;
start:
;
; read first/next track into cpmb
mov a,l
out ilow
mov a,h
out ihigh
wait0: in dstat
ani 4
jz wait0
;
; check disk status
in rtype
ani 11b
cpi 2
;
if testing
cnc rmon80 ;go to monitor if 11 or 10
endif
if not testing
jnc rstart ;retry the load
endif
;
in rbyte ;i/o complete, check status
; if not ready, then go to mon80
ral
cc rmon80 ;not ready bit set
rar ;restore
ani 11110b ;overrun/addr err/seek/crc/xxxx
;
if testing
cnz rmon80 ;go to monitor
endif
if not testing
jnz rstart ;retry the load
endif
;
;
lxi d,iopbl ;length of iopb
dad d ;addressing next iopb
dcr b ;count down tracks
jnz start
;
;
; jmp to boot to print initial message, and set up jmps
jmp boot
;
; parameter blocks
iopb0: db 80h ;iocw, no update
db readf ;read function
db bdos0 ;# sectors to read on track 0
db 0 ;track 0
db 2 ;start with sector 2 on track 0
dw cpmb ;start at base of bdos
iopbl equ $-iopb0
;
iopb1: db 80h
db readf
db bdos1 ;sectors to read on track 1
db 1 ;track 1
db 1 ;sector 1
dw cpmb+bdos0*128 ;base of second read
;
end


831
CPM OPERATING SYSTEMS/CPM 2.X/CPM 2.0/os2ccp.asm Normal file
View File

@@ -0,0 +1,831 @@
title 'console command processor (CCP), ver 2.0'
; assembly language version of the CP/M console command processor
;
; version 2.0 July, 1979
;
; Copyright (c) 1976, 1977, 1978, 1979
; Digital Research
; Box 579, Pacific Grove,
; California, 93950
;
false equ 0000h
true equ not false
testing equ false ;true if debugging
;
;
if testing
org 3400h
bdosl equ $+800h ;bdos location
else
org 000h
bdosl equ $+800h ;bdos location
endif
tran equ 100h
tranm equ $
ccploc equ $
;
; ********************************************************
; * Base of CCP contains the following code/data *
; * ccp: jmp ccpstart (start with command) *
; * jmp ccpclear (start, clear command) *
; * ccp+6 127 (max command length) *
; * ccp+7 comlen (command length = 00) *
; * ccp+8 ' ... ' (16 blanks) *
; ********************************************************
; * Normal entry is at ccp, where the command line given *
; * at ccp+8 is executed automatically (normally a null *
; * command with comlen = 00). An initializing program *
; * can be automatically loaded by storing the command *
; * at ccp+8, with the command length at ccp+7. In this *
; * case, the ccp executes the command before prompting *
; * the console for input. Note that the command is exe-*
; * cuted on both warm and cold starts. When the command*
; * line is initialized, a jump to "jmp ccpclear" dis- *
; * ables the automatic command execution. *
; ********************************************************
;
jmp ccpstart ;start ccp with possible initial command
jmp ccpclear ;clear the command buffer
maxlen: db 127 ;max buffer length
comlen: db 0 ;command length (filled in by dos)
; (command executed initially if comlen non zero)
combuf:
db ' ' ;8 character fill
db ' ' ;8 character fill
db 'COPYRIGHT (C) 1979, DIGITAL RESEARCH '; 38
ds 128-($-combuf)
; total buffer length is 128 characters
comaddr:dw combuf ;address of next to char to scan
staddr: ds 2 ;starting address of current fillfcb request
;
diska equ 0004h ;disk address for current disk
bdos equ 0005h ;primary bdos entry point
buff equ 0080h ;default buffer
fcb equ 005ch ;default file control block
;
rcharf equ 1 ;read character function
pcharf equ 2 ;print character function
pbuff equ 9 ;print buffer function
rbuff equ 10 ;read buffer function
breakf equ 11 ;break key function
liftf equ 12 ;lift head function (no operation)
initf equ 13 ;initialize bdos function
self equ 14 ;select disk function
openf equ 15 ;open file function
closef equ 16 ;close file function
searf equ 17 ;search for file function
searnf equ 18 ;search for next file function
delf equ 19 ;delete file function
dreadf equ 20 ;disk read function
dwritf equ 21 ;disk write function
makef equ 22 ;file make function
renf equ 23 ;rename file function
logf equ 24 ;return login vector
cself equ 25 ;return currently selected drive number
dmaf equ 26 ;set dma address
userf equ 32 ;set user number
;
; special fcb flags
rofile equ 9 ;read only file
sysfile equ 10 ;system file flag
;
; special characters
cr equ 13 ;carriage return
lf equ 10 ;line feed
la equ 5fh ;left arrow
eofile equ 1ah ;end of file
;
; utility procedures
printchar:
mov e,a! mvi c,pcharf! jmp bdos
;
printbc:
;print character, but save b,c registers
push b! call printchar! pop b! ret
;
crlf:
mvi a,cr! call printbc
mvi a,lf! jmp printbc
;
blank:
mvi a,' '! jmp printbc
;
print: ;print string starting at b,c until next 00 entry
push b! call crlf! pop h ;now print the string
prin0: mov a,m! ora a! rz ;stop on 00
inx h! push h ;ready for next
call printchar! pop h ;character printed
jmp prin0 ;for another character
;
initialize:
mvi c,initf! jmp bdos
;
select:
mov e,a! mvi c,self! jmp bdos
;
bdos$inr:
call bdos! sta dcnt! inr a! ret
;
open: ;open the file given by d,e
mvi c,openf! jmp bdos$inr
;
openc: ;open comfcb
xra a! sta comrec ;clear next record to read
lxi d,comfcb! jmp open
;
close: ;close the file given by d,e
mvi c,closef! jmp bdos$inr
;
search: ;search for the file given by d,e
mvi c,searf! jmp bdos$inr
;
searchn:
;search for the next occurrence of the file given by d,e
mvi c,searnf! jmp bdos$inr
;
searchcom:
;search for comfcb file
lxi d,comfcb! jmp search
;
delete: ;delete the file given by d,e
mvi c,delf! jmp bdos
;
bdos$cond:
call bdos! ora a! ret
;
diskread:
;read the next record from the file given by d,e
mvi c,dreadf! jmp bdos$cond
;
diskreadc:
;read the comfcb file
lxi d,comfcb! jmp diskread
;
diskwrite:
;write the next record to the file given by d,e
mvi c,dwritf! jmp bdos$cond
;
make: ;create the file given by d,e
mvi c,makef! jmp bdos$inr
;
renam: ;rename the file given by d,e
mvi c,renf! jmp bdos
;
getuser:
;return current user code in a
mvi e,0ffh ;drop through to setuser
;
setuser:
mvi c,userf! jmp bdos ;sets user number
;
saveuser:
;save user#/disk# before possible ^c or transient
call getuser ;code to a
add a! add a! add a! add a ;rot left
lxi h,cdisk! ora m ;4b=user, 4b=disk
sta diska ;stored away in memory for later
ret
;
setdiska:
lda cdisk! sta diska ;user/disk
ret
;
translate:
;translate character in register A to upper case
cpi 61h! rc ;return if below lower case a
cpi 7bh! rnc ;return if above lower case z
ani 5fh! ret ;translated to upper case
;
readcom:
;read the next command into the command buffer
;check for submit file
lda submit! ora a! jz nosub
;scanning a submit file
;change drives to open and read the file
lda cdisk! ora a! mvi a,0! cnz select
;have to open again in case xsub present
lxi d,subfcb! call open! jz nosub ;skip if no sub
lda subrc! dcr a ;read last record(s) first
sta subcr ;current record to read
lxi d,subfcb! call diskread ;end of file if last record
jnz nosub
;disk read is ok, transfer to combuf
lxi d,comlen! lxi h,buff! mvi b,128! call move0
;line is transferred, close the file with a
;deleted record
lxi h,submod! mvi m,0 ;clear fwflag
inx h! dcr m ;one less record
lxi d,subfcb! call close! jz nosub
;close went ok, return to original drive
lda cdisk! ora a! cnz select
;print to the 00
lxi h,combuf! call prin0
call break$key! jz noread
call del$sub! jmp ccp ;break key depressed
;
nosub: ;no submit file! call del$sub
;translate to upper case, store zero at end
call saveuser ;user # save in case control c
mvi c,rbuff! lxi d,maxlen! call bdos
call setdiska ;no control c, so restore diska
noread: ;enter here from submit file
;set the last character to zero for later scans
lxi h,comlen! mov b,m ;length is in b
readcom0: inx h! mov a,b! ora a ;end of scan?
jz readcom1! mov a,m ;get character and translate
call translate! mov m,a! dcr b! jmp readcom0
;
readcom1: ;end of scan, h,l address end of command
mov m,a ;store a zero
lxi h,combuf! shld comaddr ;ready to scan to zero
ret
;
break$key:
;check for a character ready at the console
mvi c,breakf! call bdos
ora a! rz
mvi c,rcharf! call bdos ;character cleared
ora a! ret
;
cselect:
;get the currently selected drive number to reg-A
mvi c,cself! jmp bdos
;
setdmabuff:
;set default buffer dma address
lxi d,buff ;(drop through)
;
setdma:
;set dma address to d,e
mvi c,dmaf! jmp bdos
;
del$sub:
;delete the submit file, and set submit flag to false
lxi h,submit! mov a,m! ora a! rz ;return if no sub file
mvi m,0 ;submit flag is set to false
xra a! call select ;on drive a to erase file
lxi d,subfcb! call delete
lda cdisk! jmp select ;back to original drive
;
serialize:
;check serialization
lxi d,serial! lxi h,bdosl! mvi b,6 ;check six bytes
ser0: ldax d! cmp m! jnz badserial
inx d! inx h! dcr b! jnz ser0
ret ;serial number is ok
;
comerr:
;error in command string starting at position
;'staddr' and ending with first delimiter
call crlf ;space to next line
lhld staddr ;h,l address first to print
comerr0: ;print characters until blank or zero
mov a,m! cpi ' '! jz comerr1; not blank
ora a! jz comerr1; not zero, so print it
push h! call printchar! pop h! inx h
jmp comerr0; for another character
comerr1: ;print question mark,and delete sub file
mvi a,'?'! call printchar
call crlf! call del$sub
jmp ccp ;restart with next command
;
; fcb scan and fill subroutine (entry is at fillfcb below)
;fill the comfcb, indexed by A (0 or 16)
;subroutines
delim: ;look for a delimiter
ldax d! ora a! rz ;not the last element
cpi ' '! jc comerr ;non graphic
rz ;treat blank as delimiter
cpi '='! rz
cpi la! rz ;left arrow
cpi '.'! rz
cpi ':'! rz
cpi ';'! rz
cpi '<'! rz
cpi '>'! rz
ret ;delimiter not found
;
deblank: ;deblank the input line
ldax d! ora a! rz ;treat end of line as blank
cpi ' '! rnz! inx d! jmp deblank
;
addh: ;add a to h,l
add l! mov l,a! rnc
inr h! ret
;
fillfcb0:
;equivalent to fillfcb(0)
mvi a,0
;
fillfcb:
lxi h,comfcb! call addh! push h! push h ;fcb rescanned at end
xra a! sta sdisk ;clear selected disk (in case A:...)
lhld comaddr! xchg ;command address in d,e
call deblank ;to first non-blank character
xchg! shld staddr ;in case of errors
xchg! pop h ;d,e has command, h,l has fcb address
;look for preceding file name A: B: ...
ldax d! ora a! jz setcur0 ;use current disk if empty command
sbi 'A'-1! mov b,a ;disk name held in b if : follows
inx d! ldax d! cpi ':'! jz setdsk ;set disk name if :
;
setcur: ;set current disk
dcx d ;back to first character of command
setcur0:
lda cdisk! mov m,a! jmp setname
;
setdsk: ;set disk to name in register b
mov a,b! sta sdisk ;mark as disk selected
mov m,b! inx d ;past the :
;
setname: ;set the file name field
mvi b,8 ;file name length (max)
setnam0: call delim! jz padname ;not a delimiter
inx h! cpi '*'! jnz setnam1 ;must be ?'s
mvi m,'?'! jmp setnam2 ;to dec count
;
setnam1: mov m,a ;store character to fcb! inx d
setnam2: dcr b ;count down length! jnz setnam0
;
;end of name, truncate remainder
trname: call delim! jz setty ;set type field if delimiter
inx d! jmp trname
;
padname: inx h! mvi m,' '! dcr b! jnz padname
;
setty: ;set the type field
mvi b,3! cpi '.'! jnz padty ;skip the type field if no .
inx d ;past the ., to the file type field
setty0: ;set the field from the command buffer
call delim! jz padty! inx h! cpi '*'! jnz setty1
mvi m,'?' ;since * specified! jmp setty2
;
setty1: ;not a *, so copy to type field
mov m,a! inx d
setty2: ;decrement count and go again
dcr b! jnz setty0
;
;end of type field, truncate
trtyp: ;truncate type field
call delim! jz efill! inx d! jmp trtyp
;
padty: ;pad the type field with blanks
inx h! mvi m,' '! dcr b! jnz padty
;
efill: ;end of the filename/filetype fill, save command address
;fill the remaining fields for the fcb
mvi b,3
efill0: inx h! mvi m,0! dcr b! jnz efill0
xchg! shld comaddr ;set new starting point
;
;recover the start address of the fcb and count ?'s
pop h! lxi b,11 ;b=0, c=8+3
scnq: inx h! mov a,m! cpi '?'! jnz scnq0
;? found, count it in b! inr b
scnq0: dcr c! jnz scnq
;
;number of ?'s in c, move to a and return with flags set
mov a,b! ora a! ret
;
intvec:
;intrinsic function names (all are four characters)
db 'DIR '
db 'ERA '
db 'TYPE'
db 'SAVE'
db 'REN '
db 'USER'
intlen equ ($-intvec)/4 ;intrinsic function length
serial: db 0,0,0,0,0,0
;
;
intrinsic:
;look for intrinsic functions (comfcb has been filled)
lxi h,intvec! mvi c,0 ;c counts intrinsics as scanned
intrin0: mov a,c! cpi intlen ;done with scan?! rnc
;no, more to scan
lxi d,comfcb+1 ;beginning of name
mvi b,4 ;length of match is in b
intrin1: ldax d! cmp m ;match?
jnz intrin2 ;skip if no match
inx d! inx h! dcr b
jnz intrin1 ;loop while matching
;
;complete match on name, check for blank in fcb
ldax d! cpi ' '! jnz intrin3 ;otherwise matched
mov a,c! ret ;with intrinsic number in a
;
intrin2: ;mismatch, move to end of intrinsic
inx h! dcr b! jnz intrin2
;
intrin3: ;try next intrinsic
inr c ;to next intrinsic number
jmp intrin0 ;for another round
;
ccpclear:
;clear the command buffer
xra a
sta comlen
;drop through to start ccp
ccpstart:
;enter here from boot loader
lxi sp,stack! push b ;save initial disk number
;(high order 4bits=user code, low 4bits=disk#)
mov a,c! rar! rar! rar! rar! ani 0fh ;user code
mov e,a! call setuser ;user code selected
;initialize for this user, get $ flag
call initialize ;0ffh in accum if $ file present
sta submit ;submit flag set if $ file present
pop b ;recall user code and disk number
mov a,c! ani 0fh ;disk number in accumulator
sta diska ;clears low memory user code nibble
call select ;proper disk is selected, now check sub files
;check for initial command
lda comlen! ora a! jnz ccp0 ;assume typed already
;
ccp:
;enter here on each command or error condition
lxi sp,stack
call crlf ;print d> prompt, where d is disk name
call cselect ;get current disk number
adi 'A'! call printchar
mvi a,'>'! call printchar
call readcom ;command buffer filled
ccp0: ;(enter here from initialization with command full)
lxi d,buff! call setdma ;default dma address at buff
call cselect! sta cdisk ;current disk number saved
call fillfcb0 ;command fcb filled
cnz comerr ;the name cannot be an ambiguous reference
lda sdisk! ora a! jnz userfunc
;check for an intrinsic function
call intrinsic
lxi h,jmptab ;index is in the accumulator
mov e,a! mvi d,0! dad d! dad d ;index in d,e
mov a,m! inx h! mov h,m! mov l,a! pchl
;pc changes to the proper intrinsic or user function
jmptab:
dw direct ;directory search
dw erase ;file erase
dw type ;type file
dw save ;save memory image
dw rename ;file rename
dw user ;user number
dw userfunc;user-defined function
badserial:
lxi h,di or (hlt shl 8)
shld ccploc! lxi h,ccploc! pchl
;
;
;utility subroutines for intrinsic handlers
readerr:
;print the read error message
lxi b,rdmsg! jmp print
rdmsg: db 'READ ERROR',0
;
nofile:
;print no file message
lxi b,nofmsg! jmp print
nofmsg: db 'NO FILE',0
;
getnumber: ;read a number from the command line
call fillfcb0 ;should be number
lda sdisk! ora a! jnz comerr ;cannot be prefixed
;convert the byte value in comfcb to binary
lxi h,comfcb+1! lxi b,11 ;(b=0, c=11)
;value accumulated in b, c counts name length to zero
conv0: mov a,m! cpi ' '! jz conv1
;more to scan, convert char to binary and add
inx h! sui '0'! cpi 10! jnc comerr ;valid?
mov d,a ;save value! mov a,b ;mult by 10
ani 1110$0000b! jnz comerr
mov a,b ;recover value
rlc! rlc! rlc ;*8
add b! jc comerr
add b! jc comerr ;*8+*2 = *10
add d! jc comerr ;+digit
mov b,a! dcr c! jnz conv0 ;for another digit
ret
conv1: ;end of digits, check for all blanks
mov a,m! cpi ' '! jnz comerr ;blanks?
inx h! dcr c! jnz conv1
mov a,b ;recover value! ret
;
movename:
;move 3 characters from h,l to d,e addresses
mvi b,3
move0: mov a,m! stax d! inx h! inx d
dcr b! jnz move0
ret
;
addhcf: ;buff + a + c to h,l followed by fetch
lxi h,buff! add c! call addh! mov a,m! ret
;
setdisk:
;change disks for this command, if requested
xra a! sta comfcb ;clear disk name from fcb
lda sdisk! ora a! rz ;no action if not specified
dcr a! lxi h,cdisk! cmp m! rz ;already selected
jmp select
;
resetdisk:
;return to original disk after command
lda sdisk! ora a! rz ;no action if not selected
dcr a! lxi h,cdisk! cmp m! rz ;same disk
lda cdisk! jmp select
;
;individual intrinsics follow
direct:
;directory search
call fillfcb0 ;comfcb gets file name
call setdisk ;change disk drives if requested
lxi h,comfcb+1! mov a,m ;may be empty request
cpi ' '! jnz dir1 ;skip fill of ??? if not blank
;set comfcb to all ??? for current disk
mvi b,11 ;length of fill ????????.???
dir0: mvi m,'?'! inx h! dcr b! jnz dir0
;not a blank request, must be in comfcb
dir1: mvi e,0! push d ;E counts directory entries
call searchcom ;first one has been found
cz nofile ;not found message
dir2: jz endir
;found, but may be system file
lda dcnt ;get the location of the element
rrc! rrc! rrc! ani 110$0000b! mov c,a
;c contains base index into buff for dir entry
mvi a,sysfile! call addhcf ;value to A
ral! jc dir6 ;skip if system file
;c holds index into buffer
;another fcb found, new line?
pop d! mov a,e! inr e! push d
;e=0,1,2,3,...new line if mod 4 = 0
ani 11b! push psw ;and save the test
jnz dirhdr0 ;header on current line
call crlf
push b! call cselect! pop b
;current disk in A
adi 'A'! call printbc
mvi a,':'! call printbc
jmp dirhdr1 ;skip current line hdr
dirhdr0:call blank ;after last one
mvi a,':'! call printbc
dirhdr1:
call blank
;compute position of name in buffer
mvi b,1 ;start with first character of name
dir3: mov a,b! call addhcf ;buff+a+c fetched
ani 7fh ;mask flags
;may delete trailing blanks
cpi ' '! jnz dir4 ;check for blank type
pop psw! push psw ;may be 3rd item
cpi 3! jnz dirb ;place blank at end if not
mvi a,9! call addhcf ;first char of type
ani 7fh! cpi ' '! jz dir5
;not a blank in the file type field
dirb: mvi a,' ' ;restore trailing filename chr
dir4:
call printbc ;char printed
inr b! mov a,b! cpi 12! jnc dir5
;check for break between names
cpi 9! jnz dir3 ;for another char
;print a blank between names
call blank! jmp dir3
;
dir5: ;end of current entry
pop psw ;discard the directory counter (mod 4)
dir6: call break$key ;check for interrupt at keyboard
jnz endir ;abort directory search
call searchn! jmp dir2 ;for another entry
endir: ;end of directory scan
pop d ;discard directory counter
jmp retcom
;
;
erase:
call fillfcb0 ;cannot be all ???'s
cpi 11
jnz erasefile
;erasing all of the disk
lxi b,ermsg! call print!
call readcom
lxi h,comlen! dcr m! jnz ccp ;bad input
inx h! mov a,m! cpi 'Y'! jnz ccp
;ok, erase the entire diskette
inx h! shld comaddr ;otherwise error at retcom
erasefile:
call setdisk
lxi d,comfcb! call delete
inr a ;255 returned if not found
cz nofile ;no file message if so
jmp retcom
;
ermsg: db 'ALL (Y/N)?',0
;
type:
call fillfcb0! jnz comerr ;don't allow ?'s in file name
call setdisk! call openc ;open the file
jz typerr ;zero flag indicates not found
;file opened, read 'til eof
call crlf! lxi h,bptr! mvi m,255 ;read first buffer
type0: ;loop on bptr
lxi h,bptr! mov a,m! cpi 128 ;end buffer
jc type1! push h ;carry if 0,1,...,127
;read another buffer full
call diskreadc! pop h ;recover address of bptr
jnz typeof ;hard end of file
xra a! mov m,a ;bptr = 0
type1: ;read character at bptr and print
inr m ;bptr = bptr + 1
lxi h,buff! call addh ;h,l addresses char
mov a,m! cpi eofile! jz retcom
call printchar
call break$key! jnz retcom ;abort if break
jmp type0 ;for another character
;
typeof: ;end of file, check for errors
dcr a! jz retcom
call readerr
typerr: call resetdisk! jmp comerr
;
save:
call getnumber; value to register a
push psw ;save it for later
;
;should be followed by a file to save the memory image
call fillfcb0
jnz comerr ;cannot be ambiguous
call setdisk ;may be a disk change
lxi d,comfcb! push d! call delete ;existing file removed
pop d! call make ;create a new file on disk
jz saverr ;no directory space
xra a! sta comrec; clear next record field
pop psw ;#pages to write is in a, change to #sectors
mov l,a! mvi h,0! dad h!
lxi d,tran ;h,l is sector count, d,e is load address
save0: ;check for sector count zero
mov a,h! ora l! jz save1 ;may be completed
dcx h ;sector count = sector count - 1
push h ;save it for next time around
lxi h,128! dad d! push h ;next dma address saved
call setdma ;current dma address set
lxi d,comfcb! call diskwrite
pop d! pop h ;dma address, sector count
jnz saverr ;may be disk full case
jmp save0 ;for another sector
;
save1: ;end of dump, close the file
lxi d,comfcb! call close
inr a; 255 becomes 00 if error
jnz retsave ;for another command
saverr: ;must be full or read only disk
lxi b,fullmsg! call print
retsave:
;reset dma buffer
call setdmabuff
jmp retcom
fullmsg: db 'NO SPACE',0
;
;
rename:
;rename a file on a specific disk
call fillfcb0! jnz comerr ;must be unambiguous
lda sdisk! push psw ;save for later compare
call setdisk ;disk selected
call searchcom ;is new name already there?
jnz renerr3
;file doesn't exist, move to second half of fcb
lxi h,comfcb! lxi d,comfcb+16! mvi b,16! call move0
;check for = or left arrow
lhld comaddr! xchg! call deblank
cpi '='! jz ren1 ;ok if =
cpi la! jnz renerr2
ren1: xchg! inx h! shld comaddr ;past delimiter
;proper delimiter found
call fillfcb0! jnz renerr2
;check for drive conflict
pop psw! mov b,a ;previous drive number
lxi h,sdisk! mov a,m! ora a! jz ren2
;drive name was specified. same one?
cmp b! mov m,b! jnz renerr2
ren2: mov m,b ;store the name in case drives switched
xra a! sta comfcb! call searchcom ;is old file there?
jz renerr1
;
;everything is ok, rename the file
lxi d,comfcb! call renam
jmp retcom
;
renerr1:; no file on disk
call nofile! jmp retcom
renerr2:; ambigous reference/name conflict
call resetdisk! jmp comerr
renerr3:; file already exists
lxi b,renmsg! call print! jmp retcom
renmsg: db 'FILE EXISTS',0
;
user:
;set user number
call getnumber; leaves the value in the accumulator
cpi 16! jnc comerr; must be between 0 and 15
mov e,a ;save for setuser call
lda comfcb+1! cpi ' '! jz comerr
call setuser ;new user number set
jmp endcom
;
userfunc:
call serialize ;check serialization
;load user function and set up for execution
lda comfcb+1! cpi ' '! jnz user0
;no file name, but may be disk switch
lda sdisk! ora a! jz endcom ;no disk name if 0
dcr a! sta cdisk! call setdiska ;set user/disk
call select! jmp endcom
user0: ;file name is present
lxi d,comfcb+9! ldax d! cpi ' '! jnz comerr ;type ' '
push d! call setdisk! pop d! lxi h,comtype ;.com
call movename ;file type is set to .com
call openc! jz userer
;file opened properly, read it into memory
lxi h,tran ;transient program base
load0: push h ;save dma address
xchg! call setdma
lxi d,comfcb! call diskread! jnz load1
;sector loaded, set new dma address and compare
pop h! lxi d,128! dad d
lxi d,tranm ;has the load overflowed?
mov a,l! sub e! mov a,h! sbb d! jnc loaderr
jmp load0 ;for another sector
;
load1: pop h! dcr a! jnz loaderr ;end file is 1
call resetdisk ;back to original disk
call fillfcb0! lxi h,sdisk! push h
mov a,m! sta comfcb ;drive number set
mvi a,16! call fillfcb ;move entire fcb to memory
pop h! mov a,m! sta comfcb+16
xra a! sta comrec ;record number set to zero
lxi d,fcb! lxi h,comfcb! mvi b,33! call move0
;move command line to buff
lxi h,combuf
bmove0: mov a,m! ora a! jz bmove1! cpi ' '! jz bmove1
inx h! jmp bmove0 ;for another scan
;first blank position found
bmove1: mvi b,0! lxi d,buff+1! ;ready for the move
bmove2: mov a,m! stax d! ora a! jz bmove3
;more to move
inr b! inx h! inx d! jmp bmove2
bmove3: ;b has character count
mov a,b! sta buff
call crlf
;now go to the loaded program
call setdmabuff ;default dma
call saveuser ;user code saved
;low memory diska contains user code
call tran ;gone to the loaded program
lxi sp,stack ;may come back here
call setdiska! call select
jmp ccp
;
userer: ;arrive here on command error
call resetdisk! jmp comerr
;
loaderr:;cannot load the program
lxi b,loadmsg! call print
jmp retcom
loadmsg: db 'BAD LOAD',0
comtype: db 'COM' ;for com files
;
;
retcom: ;reset disk before end of command check
call resetdisk
;
endcom: ;end of intrinsic command
call fillfcb0 ;to check for garbage at end of line
lda comfcb+1! sui ' '! lxi h,sdisk! ora m
;0 in accumulator if no disk selected, and blank fcb
jnz comerr
jmp ccp
;
;
;
; data areas
ds 16 ;8 level stack
stack:
;
; 'submit' file control block
submit: db 0 ;00 if no submit file, ff if submitting
subfcb: db 0,'$$$ ' ;file name is $$$
db 'SUB',0,0 ;file type is sub
submod: db 0 ;module number
subrc: ds 1 ;record count filed
ds 16 ;disk map
subcr: ds 1 ;current record to read
;
; command file control block
comfcb: ds 32 ;fields filled in later
comrec: ds 1 ;current record to read/write
dcnt: ds 1 ;disk directory count (used for error codes)
cdisk: ds 1 ;current disk
sdisk: ds 1 ;selected disk for current operation
;none=0, a=1, b=2 ...
bptr: ds 1 ;buffer pointer
end ccploc


2110
CPM OPERATING SYSTEMS/CPM 2.X/CPM 2.0/os3bdos.asm Normal file
View File

File diff suppressed because it is too large Load Diff

505
CPM OPERATING SYSTEMS/CPM 2.X/CPM 2.0/os4bios.asm Normal file
View File

@@ -0,0 +1,505 @@
; MDS-800 I/O Drivers for CP/M 2.0
; (four drive single density version)
;
; Version 2.0 August, 1979
;
vers equ 20 ;version 2.0
;
; Copyright (c) 1979
; Digital Research
; Box 579, Pacific Grove
; California, 93950
;
;
true equ 0ffffh ;value of "true"
false equ not true ;"false"
test equ false ;true if test bios
;
if test
bias equ 03400h ;base of CCP in test system
endif
if not test
bias equ 0000h ;generate relocatable cp/m system
endif
;
patch equ 1600h
;
org patch
cpmb equ $-patch ;base of cpm console processor
bdos equ 806h+cpmb ;basic dos (resident portion)
cpml equ $-cpmb ;length (in bytes) of cpm system
nsects equ cpml/128 ;number of sectors to load
offset equ 2 ;number of disk tracks used by cp/m
cdisk equ 0004h ;address of last logged disk on warm start
buff equ 0080h ;default buffer address
retry equ 10 ;max retries on disk i/o before error
;
; perform following functions
; boot cold start
; wboot warm start (save i/o byte)
; (boot and wboot are the same for mds)
; const console status
; reg-a = 00 if no character ready
; reg-a = ff if character ready
; conin console character in (result in reg-a)
; conout console character out (char in reg-c)
; list list out (char in reg-c)
; punch punch out (char in reg-c)
; reader paper tape reader in (result to reg-a)
; home move to track 00
;
; (the following calls set-up the io parameter block for the
; mds, which is used to perform subsequent reads and writes)
; seldsk select disk given by reg-c (0,1,2...)
; settrk set track address (0,...76) for subsequent read/write
; setsec set sector address (1,...,26) for subsequent read/write
; setdma set subsequent dma address (initially 80h)
;
; (read and write assume previous calls to set up the io parameters)
; read read track/sector to preset dma address
; write write track/sector from preset dma address
;
; jump vector for indiviual routines
jmp boot
wboote: jmp wboot
jmp const
jmp conin
jmp conout
jmp list
jmp punch
jmp reader
jmp home
jmp seldsk
jmp settrk
jmp setsec
jmp setdma
jmp read
jmp write
jmp listst ;list status
jmp sectran
;
maclib diskdef ;load the disk definition library
disks 4 ;four disks
diskdef 0,1,26,6,1024,243,64,64,offset
diskdef 1,0
diskdef 2,0
diskdef 3,0
; endef occurs at end of assembly
;
; end of controller - independent code, the remaining subroutines
; are tailored to the particular operating environment, and must
; be altered for any system which differs from the intel mds.
;
; the following code assumes the mds monitor exists at 0f800h
; and uses the i/o subroutines within the monitor
;
; we also assume the mds system has four disk drives
revrt equ 0fdh ;interrupt revert port
intc equ 0fch ;interrupt mask port
icon equ 0f3h ;interrupt control port
inte equ 0111$1110b ;enable rst 0(warm boot), rst 7 (monitor)
;
; mds monitor equates
mon80 equ 0f800h ;mds monitor
rmon80 equ 0ff0fh ;restart mon80 (boot error)
ci equ 0f803h ;console character to reg-a
ri equ 0f806h ;reader in to reg-a
co equ 0f809h ;console char from c to console out
po equ 0f80ch ;punch char from c to punch device
lo equ 0f80fh ;list from c to list device
csts equ 0f812h ;console status 00/ff to register a
;
; disk ports and commands
base equ 78h ;base of disk command io ports
dstat equ base ;disk status (input)
rtype equ base+1 ;result type (input)
rbyte equ base+3 ;result byte (input)
;
ilow equ base+1 ;iopb low address (output)
ihigh equ base+2 ;iopb high address (output)
;
readf equ 4h ;read function
writf equ 6h ;write function
recal equ 3h ;recalibrate drive
iordy equ 4h ;i/o finished mask
cr equ 0dh ;carriage return
lf equ 0ah ;line feed
;
signon: ;signon message: xxk cp/m vers y.y
db cr,lf,lf
if test
db '32' ;32k example bios
endif
if not test
db '00' ;memory size filled by relocator
endif
db 'k CP/M vers '
db vers/10+'0','.',vers mod 10+'0'
db cr,lf,0
;
boot: ;print signon message and go to ccp
; (note: mds boot initialized iobyte at 0003h)
lxi sp,buff+80h
lxi h,signon
call prmsg ;print message
xra a ;clear accumulator
sta cdisk ;set initially to disk a
jmp gocpm ;go to cp/m
;
;
wboot:; loader on track 0, sector 1, which will be skipped for warm
; read cp/m from disk - assuming there is a 128 byte cold start
; start.
;
lxi sp,buff ;using dma - thus 80 thru ff available for stack
;
mvi c,retry ;max retries
push b
wboot0: ;enter here on error retries
lxi b,cpmb ;set dma address to start of disk system
call setdma
mvi c,0 ;boot from drive 0
call seldsk
mvi c,0
call settrk ;start with track 0
mvi c,2 ;start reading sector 2
call setsec
;
; read sectors, count nsects to zero
pop b ;10-error count
mvi b,nsects
rdsec: ;read next sector
push b ;save sector count
call read
jnz booterr ;retry if errors occur
lhld iod ;increment dma address
lxi d,128 ;sector size
dad d ;incremented dma address in hl
mov b,h
mov c,l ;ready for call to set dma
call setdma
lda ios ;sector number just read
cpi 26 ;read last sector?
jc rd1
; must be sector 26, zero and go to next track
lda iot ;get track to register a
inr a
mov c,a ;ready for call
call settrk
xra a ;clear sector number
rd1: inr a ;to next sector
mov c,a ;ready for call
call setsec
pop b ;recall sector count
dcr b ;done?
jnz rdsec
;
; done with the load, reset default buffer address
gocpm: ;(enter here from cold start boot)
; enable rst0 and rst7
di
mvi a,12h ;initialize command
out revrt
xra a
out intc ;cleared
mvi a,inte ;rst0 and rst7 bits on
out intc
xra a
out icon ;interrupt control
;
; set default buffer address to 80h
lxi b,buff
call setdma
;
; reset monitor entry points
mvi a,jmp
sta 0
lxi h,wboote
shld 1 ;jmp wboot at location 00
sta 5
lxi h,bdos
shld 6 ;jmp bdos at location 5
if not test
sta 7*8 ;jmp to mon80 (may have been changed by ddt)
lxi h,mon80
shld 7*8+1
endif
; leave iobyte set
; previously selected disk was b, send parameter to cpm
lda cdisk ;last logged disk number
mov c,a ;send to ccp to log it in
ei
jmp cpmb
;
; error condition occurred, print message and retry
booterr:
pop b ;recall counts
dcr c
jz booter0
; try again
push b
jmp wboot0
;
booter0:
; otherwise too many retries
lxi h,bootmsg
call prmsg
jmp rmon80 ;mds hardware monitor
;
bootmsg:
db '?boot',0
;
;
const: ;console status to reg-a
; (exactly the same as mds call)
jmp csts
;
conin: ;console character to reg-a
call ci
ani 7fh ;remove parity bit
ret
;
conout: ;console character from c to console out
jmp co
;
list: ;list device out
; (exactly the same as mds call)
jmp lo
;
listst:
;return list status
xra a
ret ;always not ready
;
punch: ;punch device out
; (exactly the same as mds call)
jmp po
;
reader: ;reader character in to reg-a
; (exactly the same as mds call)
jmp ri
;
home: ;move to home position
; treat as track 00 seek
mvi c,0
jmp settrk
;
seldsk: ;select disk given by register c
lxi h,0000h ;return 0000 if error
mov a,c
cpi ndisks ;too large?
rnc ;leave HL = 0000
;
ani 10b ;00 00 for drive 0,1 and 10 10 for drive 2,3
sta dbank ;to select drive bank
mov a,c ;00, 01, 10, 11
ani 1b ;mds has 0,1 at 78, 2,3 at 88
ora a ;result 00?
jz setdrive
mvi a,00110000b ;selects drive 1 in bank
setdrive:
mov b,a ;save the function
lxi h,iof ;io function
mov a,m
ani 11001111b ;mask out disk number
ora b ;mask in new disk number
mov m,a ;save it in iopb
mov l,c
mvi h,0 ;HL=disk number
dad h ;*2
dad h ;*4
dad h ;*8
dad h ;*16
lxi d,dpbase
dad d ;HL=disk header table address
ret
;
;
settrk: ;set track address given by c
lxi h,iot
mov m,c
ret
;
setsec: ;set sector number given by c
lxi h,ios
mov m,c
ret
sectran:
;translate sector bc using table at de
mvi b,0 ;double precision sector number in BC
xchg ;translate table address to HL
dad b ;translate(sector) address
mov a,m ;translated sector number to A
sta ios
mov l,a ;return sector number in L
ret
;
setdma: ;set dma address given by regs b,c
mov l,c
mov h,b
shld iod
ret
;
read: ;read next disk record (assuming disk/trk/sec/dma set)
mvi c,readf ;set to read function
call setfunc
call waitio ;perform read function
ret ;may have error set in reg-a
;
;
write: ;disk write function
mvi c,writf
call setfunc ;set to write function
call waitio
ret ;may have error set
;
;
; utility subroutines
prmsg: ;print message at h,l to 0
mov a,m
ora a ;zero?
rz
; more to print
push h
mov c,a
call conout
pop h
inx h
jmp prmsg
;
setfunc:
; set function for next i/o (command in reg-c)
lxi h,iof ;io function address
mov a,m ;get it to accumulator for masking
ani 11111000b ;remove previous command
ora c ;set to new command
mov m,a ;replaced in iopb
; the mds-800 controller requires disk bank bit in sector byte
; mask the bit from the current i/o function
ani 00100000b ;mask the disk select bit
lxi h,ios ;address the sector select byte
ora m ;select proper disk bank
mov m,a ;set disk select bit on/off
ret
;
waitio:
mvi c,retry ;max retries before perm error
rewait:
; start the i/o function and wait for completion
call intype ;in rtype
call inbyte ;clears the controller
;
lda dbank ;set bank flags
ora a ;zero if drive 0,1 and nz if 2,3
mvi a,iopb and 0ffh ;low address for iopb
mvi b,iopb shr 8 ;high address for iopb
jnz iodr1 ;drive bank 1?
out ilow ;low address to controller
mov a,b
out ihigh ;high address
jmp wait0 ;to wait for complete
;
iodr1: ;drive bank 1
out ilow+10h ;88 for drive bank 10
mov a,b
out ihigh+10h
;
wait0: call instat ;wait for completion
ani iordy ;ready?
jz wait0
;
; check io completion ok
call intype ;must be io complete (00) unlinked
; 00 unlinked i/o complete, 01 linked i/o complete (not used)
; 10 disk status changed 11 (not used)
cpi 10b ;ready status change?
jz wready
;
; must be 00 in the accumulator
ora a
jnz werror ;some other condition, retry
;
; check i/o error bits
call inbyte
ral
jc wready ;unit not ready
rar
ani 11111110b ;any other errors? (deleted data ok)
jnz werror
;
; read or write is ok, accumulator contains zero
ret
;
wready: ;not ready, treat as error for now
call inbyte ;clear result byte
jmp trycount
;
werror: ;return hardware malfunction (crc, track, seek, etc.)
; the mds controller has returned a bit in each position
; of the accumulator, corresponding to the conditions:
; 0 - deleted data (accepted as ok above)
; 1 - crc error
; 2 - seek error
; 3 - address error (hardware malfunction)
; 4 - data over/under flow (hardware malfunction)
; 5 - write protect (treated as not ready)
; 6 - write error (hardware malfunction)
; 7 - not ready
; (accumulator bits are numbered 7 6 5 4 3 2 1 0)
;
; it may be useful to filter out the various conditions,
; but we will get a permanent error message if it is not
; recoverable. in any case, the not ready condition is
; treated as a separate condition for later improvement
trycount:
; register c contains retry count, decrement 'til zero
dcr c
jnz rewait ;for another try
;
; cannot recover from error
mvi a,1 ;error code
ret
;
; intype, inbyte, instat read drive bank 00 or 10
intype: lda dbank
ora a
jnz intyp1 ;skip to bank 10
in rtype
ret
intyp1: in rtype+10h ;78 for 0,1 88 for 2,3
ret
;
inbyte: lda dbank
ora a
jnz inbyt1
in rbyte
ret
inbyt1: in rbyte+10h
ret
;
instat: lda dbank
ora a
jnz insta1
in dstat
ret
insta1: in dstat+10h
ret
;
;
;
; data areas (must be in ram)
dbank: db 0 ;disk bank 00 if drive 0,1
; 10 if drive 2,3
iopb: ;io parameter block
db 80h ;normal i/o operation
iof: db readf ;io function, initial read
ion: db 1 ;number of sectors to read
iot: db offset ;track number
ios: db 1 ;sector number
iod: dw buff ;io address
;
;
; define ram areas for bdos operation
endef
end


15
CPM OPERATING SYSTEMS/CPM 2.X/CPM 2.0/os5trint.src Normal file
View File

@@ -0,0 +1,15 @@
; PIP INTERFACE TO BDOS (CAN BE USED FOR OTHER TRANSIENTS)
PUBLIC BOOT,IOBYTE,BDISK,BDOS,MON1,MON2,MON3
PUBLIC MAXB,FCB,BUFF
BOOT EQU 0000H ;WARM START
IOBYTE EQU 0003H ;IO BYTE
BDISK EQU 0004H ;BOOT DISK #
BDOS EQU 0005H ;BDOS ENTRY
MON1 EQU 0005H ;BDOS ENTRY
MON2 EQU 0005H ;BDOS ENTRY
MON3 EQU 0005H ;BDOS ENTRY
MAXB EQU 0006H ;MAX MEM BASE
FCB EQU 005CH ;DEFAULT FCB
BUFF EQU 0080H ;DEFAULT BUFFER
END


220
CPM OPERATING SYSTEMS/CPM 2.X/CPM 2.0/pip.lin Normal file
View File

@@ -0,0 +1,220 @@
0000 PIP#
0000 PIPMOD#
07E6 14 07EA 16 07F2 17 07F3 18 07F3 19
07FB 20 07FF 21 07FF 22 07FF 23 0804 24
0809 25 080A 42 080A 43 0813 44 0813 45
0813 46 081C 47 081C 49 0820 51 082D 52
082E 53 082E 54 0833 55 0838 56 0839 57
083F 59 0842 60 084B 61 084C 63 084C 64
0855 65 0855 66 0855 67 085D 68 085E 69
0862 71 086D 72 086E 73 0874 75 0880 76
0881 77 0887 79 0893 80 0894 81 089A 83
08A6 84 08A7 85 08A7 86 08B2 87 08B3 88
08B9 90 08C2 91 08C3 92 08C9 94 08D3 95
08D3 96 08D9 98 08E3 99 08E3 100 08E9 102
08F5 103 08F6 104 08FC 106 0905 107 0906 109
090C 111 0915 112 0916 113 0916 114 091F 115
091F 116 0923 118 092E 119 092F 120 092F 121
0936 122 0937 123 0937 124 093E 125 093F 126
0945 128 094F 129 094F 130 0955 132 095F 133
095F 134 0965 136 096E 137 096F 140 096F 141
0974 142 097C 143 097D 145 097D 146 0986 147
0986 149 098C 151 0995 152 0996 153 0996 155
099A 156 099E 157 09A7 158 09AA 159 09AF 160
09AF 162 09B5 164 09B8 165 09C0 166 09C5 167
09CA 168 09DA 169 09E4 170 09F1 171 09F8 172
09FD 173 0A03 174 0A0B 175 0A11 176 0A14 177
0A17 178 0A18 179 0A27 182 0A33 183 0A3D 184
0A44 185 0A4B 186 0A4E 187 0A4F 188 0A4F 190
0A55 191 0A5C 192 0A5F 193 0A6E 194 0A7B 195
0A89 197 0A91 198 0A97 199 0A9D 200 0AA4 201
0AAA 202 0AAD 203 0AB7 204 0ABE 205 0AC4 206
0AC7 207 0AC8 208 0AC8 212 0ADA 213 0ADB 214
0AE1 215 0AE8 216 0AEE 217 0AFD 218 0B07 219
0B0F 220 0B1A 221 0B20 222 0B2A 223 0B31 224
0B38 226 0B3E 227 0B44 228 0B53 229 0B61 230
0B68 231 0B6D 232 0B7B 233 0B9B 234 0B9F 235
0BA2 236 0BAC 237 0BB3 238 0BB9 239 0BC0 240
0BC9 241 0BC9 242 0BCF 243 0BD0 244 0BD4 246
0BDC 248 0BE0 249 0BE9 251 0BF3 252 0BF4 253
0BF4 254 0BF4 255 0BFA 256 0C0A 257 0C0A 258
0C16 259 0C19 260 0C24 261 0C2B 262 0C2E 263
0C31 264 0C34 265 0C37 266 0C3A 267 0C3D 268
0C46 269 0C50 270 0C50 271 0C55 272 0C58 273
0C5B 274 0C5B 275 0C60 276 0C63 277 0C66 278
0C66 279 0C6B 280 0C6E 281 0C71 282 0C7F 283
0C7F 284 0C84 285 0C87 286 0C8A 287 0C8A 288
0C8F 289 0C92 290 0C95 291 0C95 292 0C9A 293
0C9D 294 0CA0 295 0CAE 296 0CAE 297 0CB3 298
0CB6 299 0CB9 300 0CB9 301 0CBE 302 0CC1 303
0CC4 304 0CC4 305 0CC9 306 0CCC 307 0CCF 308
0CDD 309 0D05 310 0D0B 311 0D0C 312 0D10 314
0D18 315 0D22 316 0D2A 317 0D34 319 0D3A 320
0D44 321 0D4E 322 0D51 323 0D59 324 0D62 325
0D66 326 0D6B 327 0D6E 328 0D6E 329 0D76 330
0D7B 331 0D7C 332 0D80 334 0D91 335 0D99 336
0DA2 337 0DA3 338 0DA7 340 0DB4 341 0DBD 342
0DBE 343 0DBE 345 0DC3 346 0DCE 347 0DD6 348
0DDF 349 0DE8 350 0DEF 351 0DF6 352 0DFD 353
0E05 355 0E0A 356 0E0F 357 0E12 358 0E17 359
0E18 360 0E18 363 0E21 364 0E2A 365 0E2D 366
0E3C 367 0E44 368 0E45 369 0E49 371 0E50 373
0E58 374 0E59 375 0E59 376 0E60 378 0E68 380
0E73 382 0E7B 383 0E80 384 0E8E 386 0E93 387
0E98 388 0E98 389 0E98 390 0EA1 391 0EA4 392
0EA9 393 0EA9 394 0EA9 395 0EB0 397 0EC8 399
0ECB 400 0ECC 401 0ECC 402 0ECC 403 0ED4 404
0ED9 405 0EE0 406 0EE8 407 0EED 408 0EEE 409
0EF2 411 0F09 412 0F11 413 0F15 414 0F15 415
0F19 417 0F30 418 0F38 419 0F3C 420 0F3C 421
0F3C 423 0F47 425 0F59 427 0F61 428 0F64 429
0F6A 430 0F6D 431 0F6D 432 0F6D 433 0F72 434
0F78 435 0F88 436 0F88 437 0F94 438 0F97 439
0FA3 440 0FAA 441 0FAD 442 0FB6 443 0FBF 444
0FBF 445 0FC4 446 0FC7 447 0FCA 448 0FCA 449
0FCF 450 0FD2 451 0FD5 452 0FD5 453 0FDA 454
0FDD 455 0FE0 456 0FF0 457 0FF3 458 0FF6 459
0FF9 460 0FFC 461 0FFF 462 1002 463 1005 464
1008 465 1008 466 100E 467 1011 468 1011 469
1016 470 1019 471 101C 472 101C 473 1021 474
1024 475 1027 476 1027 477 102C 478 102F 479
1032 480 1032 481 1037 482 1042 483 1045 484
106D 485 1073 486 107A 488 1080 489 1085 490
108C 491 1092 492 1092 493 1099 495 10A0 496
10B2 497 10BD 498 10C4 500 10CB 502 10D3 503
10D6 504 10DC 505 10DC 506 10DC 507 10DC 508
10E3 509 10EB 510 10F2 511 10FA 512 1101 513
1109 514 110D 515 110D 516 11AD 518 11B1 520
11C9 522 11D6 523 11D9 524 11D9 525 11E3 526
11EA 527 11EF 528 11F2 529 110D 530 1116 532
1122 533 1125 534 1128 535 1128 536 1128 537
1131 539 1135 540 1141 541 1145 542 1146 543
1146 544 1151 545 1154 546 115D 548 1168 550
116E 551 1173 552 117A 553 117A 554 117D 555
1186 557 1191 559 1196 560 119B 561 119E 562
119E 563 11A2 564 11A5 565 11A9 566 11AC 567
11F2 569 11F2 570 1200 571 1203 572 1211 573
1211 574 1211 575 121C 576 121F 577 1220 578
1438 581 143C 584 144A 585 145A 586 145D 587
1464 588 1467 589 1467 590 1467 591 1479 592
1481 593 1486 594 1487 595 148B 597 1490 598
149A 599 149D 600 14A0 601 14A1 602 14A5 604
14B1 605 14B1 606 14B1 608 14B6 609 14BC 610
14C2 611 14DA 612 14E9 614 14F1 615 14FA 616
1500 617 1503 619 151B 621 1522 622 153D 623
1540 624 1546 625 1549 626 155B 627 1563 628
1575 629 158A 630 158D 631 159A 632 15A2 634
15AB 635 15B1 636 15B7 637 15B7 638 15B7 639
15BA 640 15C0 641 15C1 642 15C1 643 15C9 644
15CE 645 1226 646 122B 647 1230 648 1233 649
1238 650 1240 651 1248 652 124D 653 1250 654
1253 655 1256 656 125C 657 1267 659 126A 660
126F 661 1270 662 1270 663 1275 664 1283 665
128E 666 1295 667 129A 668 12A5 669 12A5 670
12AA 671 12B5 672 12BD 673 12BE 674 12C6 675
12CE 676 12D1 677 12D7 678 12DA 679 12E2 681
12EA 682 12EB 683 12F3 685 1305 686 1306 687
1309 688 1314 690 131C 691 131F 692 1323 693
1328 694 1329 695 1329 696 132C 697 1334 698
1335 701 133A 702 1346 703 134B 704 137B 705
137E 706 1386 708 138B 709 1393 710 1396 711
139A 712 13A0 713 13A1 714 13A1 715 13A9 716
13B0 717 13B1 718 13B1 719 13B9 720 13BC 721
13BF 723 13C7 724 13C8 725 13CD 726 13D5 727
13E3 728 13EB 729 13EC 730 13F4 731 13FC 732
13FF 733 1402 734 140A 735 140D 736 1411 737
1416 738 141E 739 1425 740 1433 741 1434 742
1434 743 1437 744 15CF 745 15CF 747 15DD 748
15E2 749 15E9 750 15EA 752 15F0 754 15FC 755
15FD 756 1607 758 1610 759 1623 760 1626 761
162D 762 1634 763 1637 764 163A 765 163A 766
163A 767 1640 768 1647 769 1653 770 165C 771
165C 772 1713 775 1719 777 1720 779 1725 780
172D 781 172D 782 172E 783 172E 784 1735 786
173A 787 173D 788 173D 789 173E 790 173E 792
1745 794 1750 795 1755 796 1758 797 1765 798
1771 799 1777 800 177B 801 177B 802 177E 803
177E 805 177E 807 178D 808 1793 809 179F 810
17A5 811 17AD 812 17AD 813 17AD 814 17BC 815
17BC 816 17BC 817 17C5 818 17C5 819 17C5 820
17DB 821 165C 822 1661 823 1666 824 1671 825
1676 826 167E 828 1684 829 168C 830 168F 831
1694 832 1694 833 1697 834 169A 835 169F 836
16AA 838 16B5 839 16B8 840 16BB 841 16C2 842
16C5 843 16C8 844 16C8 845 16CE 846 16D4 847
16E4 848 16E8 849 16EE 850 16F1 851 16FD 852
1703 853 1706 854 170D 855 1710 856 1713 857
17DB 858 17DB 860 17DB 861 17E8 862 17F8 863
1807 864 1816 865 181D 866 1822 867 1827 868
182F 869 1830 870 1833 871 1836 872 1841 873
1847 874 184D 875 1850 876 1858 877 1859 878
185C 879 185D 880 185D 881 1863 882 1864 883
1864 884 186B 885 1877 886 1883 887 188B 888
1893 889 1899 890 189F 891 18A5 892 18AD 893
18B3 894 18BE 895 18BF 896 18BF 897 18C5 898
18C8 899 18CF 900 18D5 901 18D8 902 18E8 903
18ED 904 18F5 905 18FB 906 1900 907 190C 908
1912 909 1913 910 1913 911 191C 912 1922 913
192B 914 1931 915 1932 916 1936 918 193D 919
1946 920 194B 921 1956 922 195A 923 195F 924
1962 925 1965 926 1968 927 196F 928 1975 929
197D 930 1983 931 1989 932 198F 933 1997 935
199F 937 19A6 939 19AC 940 19B8 942 19BE 943
19C1 944 19C7 945 19CD 946 19CE 947 19CE 948
19D1 949 19D1 950 19D9 951 19DF 952 19DF 953
19E5 954 19E5 955 19F1 956 19F7 957 19FD 958
19FE 959 19FE 960 1A11 961 1A12 962 1A12 963
1A18 964 1A24 965 1A2D 966 1A38 967 1A3B 968
1A3C 969 1A3C 970 1A52 971 1A64 972 1A67 973
1A68 974 1A68 976 1A7B 977 1A7E 978 1A89 979
1A8F 980 1A96 981 1A9D 982 1AA0 983 1AA7 985
1AAA 986 1AAD 987 1AAD 988 1AAE 989 1B42 991
1B42 992 1B50 993 1AAE 994 1AB1 995 1AB7 996
1ABA 997 1ABD 998 1AC2 999 1ACE 1000 1ADD 1002
1AF5 1003 1AFA 1004 1AFA 1005 1B01 1006 1B08 1008
1B0B 1009 1B12 1010 1B15 1011 1B1C 1012 1B25 1013
1B2B 1014 1B2E 1015 1B31 1016 1B34 1017 1B37 1018
1B3A 1019 1B41 1020 1B50 1021 1C0F 1023 1C0F 1025
1C12 1026 1C20 1027 1C32 1029 1C3A 1030 1C3F 1031
1C46 1032 1C46 1033 1C4D 1034 1B50 1035 1B5A 1036
1B5A 1037 1B5D 1038 1B64 1039 1B6A 1040 1B70 1041
1B75 1042 1B8D 1043 1B91 1044 1B94 1045 1B97 1046
1B9A 1047 1BA2 1049 1BAA 1050 1BB0 1051 1BB3 1052
1BB4 1053 1BB4 1054 1BBB 1055 1BD5 1056 1BE1 1057
1BE6 1058 1BF3 1060 1BFF 1061 1C05 1062 1C08 1063
1C0B 1064 1C0B 1065 1C0E 1066 1C4E 1067 1C4E 1068
1C57 1069 1C61 1070 1C67 1071 1C68 1072 1C68 1073
1C6F 1074 1C72 1075 1C7B 1076 1C85 1077 1C8B 1078
1C8C 1079 1C8C 1080 1C96 1081 1C97 1082 1CA1 1083
1CA4 1084 1CA5 1085 1CA5 1086 1CA8 1087 1CB0 1088
1CB3 1089 1CB4 1090 1CBA 1092 1CBD 1093 1CC0 1094
1CCE 1095 1CD1 1096 1CD2 1097 1CD2 1098 1CD8 1099
1CF0 1100 1CF3 1101 1CF9 1102 04CE 1103 04DD 1104
04E8 1105 04F4 1107 04FA 1108 04FD 1109 04FD 1110
0503 1111 050E 1112 0517 1113 051A 1114 051A 1115
0525 1116 052A 1117 0532 1118 0535 1119 053C 1121
0541 1122 0544 1123 0547 1124 0547 1125 054C 1126
0554 1128 055B 1129 055E 1130 055E 1131 0570 1132
0576 1133 057E 1134 0581 1135 0589 1137 0590 1138
0593 1139 0599 1140 05A1 1141 05A4 1142 05AB 1144
05B1 1145 05B4 1146 05B7 1148 05BD 1149 05C0 1150
05C0 1151 05C3 1152 05C3 1153 05D3 1154 05D6 1155
05D9 1156 05DC 1157 05E2 1158 05EA 1160 05ED 1161
05F0 1162 05FC 1163 05FF 1164 0602 1165 0605 1166
0605 1167 060D 1169 0610 1170 0618 1171 061B 1172
061E 1173 0621 1174 0624 1175 0624 1176 0629 1177
062F 1178 063D 1179 0643 1180 0648 1181 0650 1183
0653 1184 0656 1185 065B 1186 065E 1187 0675 1188
067B 1189 0687 1190 068A 1191 0690 1192 06A8 1193
06AE 1194 06B3 1195 06BA 1196 06C0 1197 06C6 1198
06CB 1199 06DF 1201 06E2 1202 06E5 1203 06EA 1204
06ED 1205 070D 1206 0713 1207 071B 1208 0722 1209
072A 1210 0730 1211 0738 1212 0740 1214 074E 1215
0753 1216 075B 1218 0760 1219 0768 1220 076D 1221
0775 1222 077A 1223 077A 1224 077D 1225 077D 1226
0780 1227 0786 1228 07AA 1229 07B0 1230 07BB 1231
07BE 1232 07C6 1234 07CB 1235 07CE 1236 07CE 1237
07D6 1238 07DB 1239 07E1 1240 07E4 1241
0000 MODULE#


1592
CPM OPERATING SYSTEMS/CPM 2.X/CPM 2.0/pip.plm Normal file
View File

File diff suppressed because it is too large Load Diff

45
CPM OPERATING SYSTEMS/CPM 2.X/CPM 2.0/pip20pat.asm Normal file
View File

@@ -0,0 +1,45 @@
; pip patch for cp/m 2.0 operation 10/4/79
;
; this patch fixes two errors which occur when
; pip operates under the cp/m 2.0 release:
; (1) the operation pip x=x,x previously
; resulted in a duplicate file when the
; final file size exceeded 16k bytes,
; (2) the sequence of operations
; user 5
; pip b:=*.*
; resulted in a BDOS disk select error
;
;
; pl/m source level changes:
; 0931.1 dest(freel) = 0;
; 1055.1 dest(0) = 0;
; 1057.0 (deleted)
;
; assembly language field patch:
;
org 01f0h ;patch area in pip
dest equ 1dd8h ;location of "dest"
freel equ 12 ;constant offset
open equ 086eh ;local open subroutine
;
p1: ;patch #1 for line 931.1
lxi h,freel
dad b ;hl=.dest(freel)
mvi m,0 ;dest(freel)=0
jmp open ;open file
;
p2: ;patch #2 for line 1055.1
lxi b,dest
xra a ;zero to accum
stax b ;dest(0)=0
ret
;
; code overlays
org 198ch ;line 931.1
call p1 ;patch #1
;
org 1bd5h ;line 1055.1
call p2 ;patch #2
end


1
CPM OPERATING SYSTEMS/CPM 2.X/CPM 2.0/readme.md Normal file
View File

@@ -0,0 +1 @@
CP/M 2.0 sources in PL/M and Assembly language. Includes BIOS for the MDS-800.

117
CPM OPERATING SYSTEMS/CPM 2.X/CPM 2.0/stat.lin Normal file
View File

@@ -0,0 +1,117 @@
0000 STAT#
0000 STAT#
0433 16 0490 20 0494 22 049F 23 04A0 24
04A0 25 04A5 26 04AA 27 04AB 28 04AB 29
04B0 30 04B1 31 04B7 34 04C0 35 04C7 36
04CE 37 04D1 38 04D2 39 04D8 41 04DB 42
04E3 43 04E4 44 04E4 45 04ED 46 04ED 48
04ED 49 04F6 50 04F6 51 04FA 53 0505 54
0506 55 050C 57 0518 58 0519 59 051F 61
052B 62 052C 63 052C 64 0537 65 0538 66
0538 67 0541 68 0541 69 0547 71 0550 72
0551 73 0551 74 055A 75 055A 76 055A 77
0563 78 0563 79 0563 80 056B 81 056C 82
056C 83 0575 84 0575 85 0575 86 057D 87
057E 88 057E 89 0589 90 058A 91 058A 92
0593 93 0593 94 0597 96 05A2 97 05A3 98
05A9 100 05B2 101 05B3 105 05B3 106 05B6 107
05CB 108 05CC 109 05D0 111 05D7 112 05DA 113
05DB 114 05E1 116 05FE 117 05FE 119 0604 123
0612 124 062C 125 062F 126 0636 127 0639 128
0639 129 06EB 131 06EF 133 06FC 134 0700 135
0639 136 0648 137 064C 138 064F 139 0654 140
065C 141 0670 142 067A 143 067F 144 06D1 145
06DF 146 06E3 147 06E6 148 06EA 149 0701 150
070B 152 0710 153 071C 154 072A 155 0734 156
0740 157 075B 158 0761 160 0766 161 076F 162
076F 163 0772 164 0773 165 077D 169 078C 170
0799 171 07A8 172 07B3 173 07B6 174 07B7 175
07BB 178 07C4 179 07C8 180 07DF 181 07E6 182
07F1 183 07F8 184 0801 185 080E 186 0812 187
0812 188 0812 189 0818 190 0819 191 0819 195
081F 196 082B 197 0831 198 083F 199 084A 200
0851 201 0857 202 085D 203 0865 204 087F 205
088D 206 0890 207 0893 208 08A1 209 08AF 210
08BB 211 08C2 212 08C3 213 09C0 215 09C6 217
09C9 218 09D4 219 09D9 220 09DC 221 08C3 222
08C9 223 08D2 224 08D7 225 08DD 226 08EC 227
091C 228 0925 229 092D 230 0933 231 093D 232
0943 233 0951 234 0957 235 0969 236 096F 237
0986 238 098C 239 0994 240 099A 241 09A3 242
09A9 243 09B6 244 09BC 245 09BF 246 09DD 247
09DD 249 09E3 250 09E8 251 09F4 252 09FC 254
0A03 255 0A06 256 0A06 257 0A13 258 0A15 259
0A18 260 0A19 261 0A21 264 0A2B 265 0A37 266
0A3C 267 0A4A 268 0A64 269 0A69 270 0A6D 271
0A72 272 0A79 273 0A7D 274 0A84 275 0A87 276
0A87 278 0C69 281 0C6F 283 0C78 284 0C7F 285
0C86 286 0C89 287 0C8E 288 0A87 289 0A8C 290
0A8C 291 0A8F 292 0A9F 293 0AA8 294 0AAC 295
0AB4 297 0ABA 298 0ABF 299 0ACB 300 0ADC 301
0AE2 302 0AF9 303 0B01 304 0B0B 305 0B0E 306
0B15 307 0B18 308 0B20 310 0B26 311 0B2C 312
0B32 313 0B38 314 0B3E 315 0B4C 316 0B4F 317
0B60 318 0B66 319 0B85 320 0B8A 321 0BA1 322
0BA4 323 0BAB 324 0BAE 325 0BB6 327 0BB9 328
0BBC 329 0BBF 330 0BC7 331 0BCD 333 0BDB 334
0BDE 335 0BE6 337 0BEC 338 0BEF 339 0BEF 340
0BF2 341 0C0B 343 0C11 344 0C14 345 0C14 346
0C19 347 0C25 348 0C2D 349 0C35 350 0C38 351
0C46 352 0C46 353 0C49 354 0C51 355 0C54 356
0C5C 358 0C62 359 0C65 360 0C65 361 0C68 362
0C8F 363 0C95 365 0C9B 366 0CA0 367 0CAC 368
0CBA 369 0CC4 370 0CD0 371 0CEB 373 0CF0 374
0CF9 375 0CF9 376 0CFC 377 0D01 378 0D04 379
0D05 380 0D05 381 0D0B 382 0D14 383 0D1A 384
0D1B 385 0D1B 386 0D25 387 0D26 388 0D26 389
0D2C 390 0D2F 391 0D32 392 0D33 393 0D33 396
0D39 397 0D3F 398 0D44 399 0D50 400 0D58 402
0D5F 403 0D62 404 0D68 405 0D70 406 0D78 407
0D7D 408 0D83 409 0D86 410 0D86 411 0D93 412
0DA0 413 0DA2 414 0DA5 415 0DA8 416 0DA9 417
0DA9 418 0DB1 419 0DB9 420 0DBA 421 135D 425
135D 426 136B 427 136C 430 136C 432 1374 433
1377 434 1387 435 139F 436 13A7 437 13B7 438
13BD 439 13C0 440 13C0 441 13C0 443 13CE 444
13E3 446 13EB 447 13F0 448 13F7 449 13F7 450
1401 451 0DBA 452 0DBD 453 0DC0 454 0DC5 455
0DCA 456 0DD1 458 0DD9 459 0DDA 460 0DE1 461
0DE4 462 0DEC 464 0DEF 465 0DF0 466 0DF0 467
0DFA 468 0E04 469 0E0A 470 0E12 471 0E24 472
0E29 473 0E2F 474 0E45 475 0E48 476 0E56 477
0E71 478 0E79 479 0E84 480 0E8E 481 0E95 482
0E98 483 0E9F 484 0EA9 486 0EB3 487 0EB6 488
0ED8 490 0EDE 491 0EE4 492 0EEA 493 0EED 494
0EED 495 0EFE 496 0F0C 497 0F24 498 0F2E 499
0F60 500 0F60 501 0F79 502 0FB9 503 0FBE 504
0FCD 505 0FD2 506 0FF1 507 0FFF 508 1007 509
101C 510 1024 511 103A 512 103D 513 1040 514
1043 515 104F 516 1058 517 1060 519 106B 521
1071 522 107C 523 1082 524 1097 525 10A6 526
10A9 527 10AF 528 10BE 529 10C1 530 10CF 531
10F3 533 1102 534 111B 535 112C 536 1133 537
1138 538 113B 539 1145 540 114A 541 1154 542
1161 543 1164 544 1164 545 116B 546 1174 547
1177 548 117D 549 1183 550 118F 551 119E 552
11A1 553 11A4 554 11B8 555 11BD 556 11C4 558
11CA 559 11D2 560 11DB 561 11E6 562 11E9 563
11E9 564 11FA 565 11FD 566 120E 567 1213 568
1216 569 1227 570 122A 571 122F 572 1234 573
1241 574 1249 575 124E 576 1251 577 125A 578
125F 579 126F 580 1274 581 1277 582 127E 583
1283 584 128A 585 128D 586 1290 587 1293 588
1293 589 1299 590 12A5 591 12AC 593 12AF 594
12B0 595 12B0 596 12B6 597 12B9 598 12BC 599
12BF 600 12CF 601 12E1 602 12F3 603 1305 604
1317 605 131F 606 1333 607 1338 608 133B 609
1341 610 1352 611 1359 612 135C 613 135C 614
1402 615 1402 616 1405 617 1408 618 1410 620
1413 621 141D 623 1420 624 1423 625 1426 626
142C 627 142F 629 1432 630 143F 631 1445 632
1448 633 1448 634 0433 635 043A 636 043E 637
0446 638 044F 640 0454 641 046C 642 0472 644
047A 645 0480 647 0488 648 048B 649 048B 650
048B 651 048B 652 048F 653
0000 MODULE#


894
CPM OPERATING SYSTEMS/CPM 2.X/CPM 2.0/stat.plm Normal file
View File

@@ -0,0 +1,894 @@
stat:
do;
declare
cpmversion literally '20h'; /* requires 2.0 cp/m */
/* c p / m s t a t u s c o m m a n d (s t a t) */
/* status status status status status status */
/* status status status status status status */
/* status status status status status status */
/* status status status status status status */
/* status status status status status status */
/* status status status status status status */
/* status status status status status status */
/* status status status status status status */
/* status status status status status status */
/* status status status status status status */
/* status status status status status status */
/* status status status status status status */
/* status status status status status status */
/* status status status status status status */
/* status status status status status status */
/* status status status status status status */
/* status status status status status status */
/* status status status status status status */
/* status status status status status status */
/* status status status status status status */
/* status status status status status status */
/* status status status status status status */
/* status status status status status status */
/*
copyright(c) 1975, 1976, 1977, 1978, 1979
digital research
box 579
pacific grove, ca
93950
*/
/* modified 10/30/78 to fix the space computation */
/* modified 01/28/79 to remove despool dependencies */
/* modified 07/26/79 to operate under cp/m 2.0 */
declare jump byte data(0c3h),
jadr address data (.status);
/* jump to status */
/* function call 32 returns the address of the disk parameter
block for the currently selected disk, which consists of:
scptrk (2 by) number of sectors per track
blkshf (1 by) log2 of blocksize (2**blkshf=blksize)
blkmsk (1 by) 2**blkshf-1
extmsk (1 by) logical/physical extents
maxall (2 by) max alloc number
dirmax (2 by) size of directory-1
dirblk (2 by) reservation bits for directory
chksiz (2 by) size of checksum vector
offset (2 by) offset for operating system
*/
declare
/* fixed locations for cp/m */
bdosa literally '0006h', /* bdos base */
buffa literally '0080h', /* default buffer */
fcba literally '005ch', /* default file control block */
dolla literally '006dh', /* dollar sign position */
parma literally '006eh', /* parameter, if sent */
rreca literally '007dh', /* random record 7d,7e,7f */
rreco literally '007fh', /* high byte of random overflow */
ioba literally '0003h', /* iobyte address */
sectorlen literally '128', /* sector length */
memsize address at(bdosa), /* end of memory */
rrec address at(rreca), /* random record address */
rovf byte at(rreco), /* overflow on getfile */
doll byte at(dolla), /* dollar parameter */
parm byte at(parma), /* parameter */
sizeset byte, /* true if displaying size field */
dpba address, /* disk parameter block address */
dpb based dpba structure
(spt address, bls byte, bms byte, exm byte, mxa address,
dmx address, dbl address, cks address, ofs address),
scptrk literally 'dpb.spt',
blkshf literally 'dpb.bls',
blkmsk literally 'dpb.bms',
extmsk literally 'dpb.exm',
maxall literally 'dpb.mxa',
dirmax literally 'dpb.dmx',
dirblk literally 'dpb.dbl',
chksiz literally 'dpb.cks',
offset literally 'dpb.ofs';
boot: procedure external;
/* reboot */
end boot;
mon1: procedure(f,a) external;
declare f byte, a address;
end mon1;
mon2: procedure(f,a) byte external;
declare f byte, a address;
end mon2;
mon3: procedure(f,a) address external;
declare f byte, a address;
end mon3;
status: procedure;
declare copyright(*) byte data (
' Copyright (c) 1979, Digital Research');
/* dummy outer procedure 'status' will start at 100h */
/* determine status of currently selected disk */
declare alloca address,
/* alloca is the address of the disk allocation vector */
alloc based alloca (1024) byte; /* allocation vector */
declare
true literally '1',
false literally '0',
forever literally 'while true',
cr literally '13',
lf literally '10';
printchar: procedure(char);
declare char byte;
call mon1(2,char);
end printchar;
crlf: procedure;
call printchar(cr);
call printchar(lf);
end crlf;
printb: procedure;
/* print blank character */
call printchar(' ');
end printb;
printx: procedure(a);
declare a address;
declare s based a byte;
do while s <> 0;
call printchar(s);
a = a + 1;
end;
end printx;
print: procedure(a);
declare a address;
/* print the string starting at address a until the
next 0 is encountered */
call crlf;
call printx(a);
end print;
break: procedure byte;
return mon2(11,0); /* console ready */
end break;
declare dcnt byte;
version: procedure byte;
/* returns current cp/m version # */
return mon2(12,0);
end version;
select: procedure(d);
declare d byte;
call mon1(14,d);
end select;
open: procedure(fcb);
declare fcb address;
dcnt = mon2(15,fcb);
end open;
search: procedure(fcb);
declare fcb address;
dcnt = mon2(17,fcb);
end search;
searchn: procedure;
dcnt = mon2(18,0);
end searchn;
cselect: procedure byte;
/* return current disk number */
return mon2(25,0);
end cselect;
setdma: procedure(dma);
declare dma address;
call mon1(26,dma);
end setdma;
getalloca: procedure address;
/* get base address of alloc vector */
return mon3(27,0);
end getalloca;
getlogin: procedure address;
/* get the login vector */
return mon3(24,0);
end getlogin;
writeprot: procedure;
/* write protect the current disk */
call mon1(28,0);
end writeprot;
getrodisk: procedure address;
/* get the read-only disk vector */
return mon3(29,0);
end getrodisk;
setind: procedure;
/* set file indicators for current fcb */
call mon1(30,fcba);
end setind;
set$dpb: procedure;
/* set disk parameter block values */
dpba = mon3(31,0); /* base of dpb */
end set$dpb;
getuser: procedure byte;
/* return current user number */
return mon2(32,0ffh);
end getuser;
setuser: procedure(user);
declare user byte;
call mon1(32,user);
end setuser;
getfilesize: procedure(fcb);
declare fcb address;
call mon1(35,fcb);
end getfilesize;
declare oldsp address, /* sp on entry */
stack(16) address; /* this program's stack */
declare
fcbmax literally '512', /* max fcb count */
fcbs literally 'memory',/* remainder of memory */
fcb(33) byte at (fcba), /* default file control block */
buff(128) byte at (buffa), /* default buffer */
ioval byte at (ioba); /* io byte */
declare bpb address; /* bytes per block */
set$bpb: procedure;
call set$dpb; /* disk parameters set */
bpb = shl(double(1),blkshf) * sectorlen;
end set$bpb;
select$disk: procedure(d);
declare d byte;
/* select disk and set bpb */
call select(d);
call set$bpb; /* bytes per block */
end select$disk;
getalloc: procedure(i) byte;
/* return the ith bit of the alloc vector */
declare i address;
return
rol(alloc(shr(i,3)), (i and 111b) + 1);
end getalloc;
declare
accum(4) byte, /* accumulator */
ibp byte; /* input buffer pointer */
compare: procedure(a) byte;
/* compare accumulator with four bytes addressed by a */
declare a address;
declare (s based a) (4) byte;
declare i byte;
do i = 0 to 3;
if s(i) <> accum(i) then return false;
end;
return true;
end compare;
scan: procedure;
/* fill accum with next input value */
declare (i,b) byte;
setacc: procedure(b);
declare b byte;
accum(i) = b; i = i + 1;
end setacc;
/* deblank input */
do while buff(ibp) = ' '; ibp=ibp+1;
end;
/* initialize accum length */
i = 0;
do while i < 4;
if (b := buff(ibp)) > 1 then /* valid */
call setacc(b); else /* blank fill */
call setacc(' ');
if b <= 1 or b = ',' or b = ':' or
b = '*' or b = '.' or b = '>' or
b = '<' or b = '=' then buff(ibp) = 1;
else
ibp = ibp + 1;
end;
ibp = ibp + 1;
end scan;
pdecimal: procedure(v,prec);
/* print value v with precision prec (10,100,1000)
with leading zero suppression */
declare
v address, /* value to print */
prec address, /* precision */
zerosup byte, /* zero suppression flag */
d byte; /* current decimal digit */
zerosup = true;
do while prec <> 0;
d = v / prec ; /* get next digit */
v = v mod prec;/* get remainder back to v */
prec = prec / 10; /* ready for next digit */
if prec <> 0 and zerosup and d = 0 then call printb; else
do; zerosup = false; call printchar('0'+d);
end;
end;
end pdecimal;
add$block: procedure(ak,ab);
declare (ak, ab) address;
/* add one block to the kilobyte accumulator */
declare kaccum based ak address; /* kilobyte accum */
declare baccum based ab address; /* byte accum */
baccum = baccum + bpb;
do while baccum >= 1024;
baccum = baccum - 1024;
kaccum = kaccum + 1;
end;
end add$block;
count: procedure(mode) address;
declare mode byte; /* true if counting 0's */
/* count kb remaining, kaccum set upon exit */
declare
ka address, /* kb accumulator */
ba address, /* byte accumulator */
i address, /* local index */
bit byte; /* always 1 if mode = false */
ka, ba = 0;
bit = 0;
do i = 0 to maxall;
if mode then bit = getalloc(i);
if not bit then call add$block(.ka,.ba);
end;
return ka;
end count;
abortmsg: procedure;
call print(.('** Aborted **',0));
end abortmsg;
userstatus: procedure;
/* display active user numbers */
declare i byte;
declare user(32) byte;
declare ufcb(*) byte data ('????????????',0,0,0);
call print(.('Active User :',0));
call pdecimal(getuser,10);
call print(.('Active Files:',0));
do i = 0 to last(user);
user(i) = false;
end;
call setdma(.fcbs);
call search(.ufcb);
do while dcnt <> 255;
if (i := fcbs(shl(dcnt and 11b,5))) <> 0e5h then
user(i and 1fh) = true;
call searchn;
end;
do i = 0 to last(user);
if user(i) then call pdecimal(i,10);
end;
end userstatus;
drivestatus: procedure;
declare
rpb address,
rpd address;
pv: procedure(v);
declare v address;
call crlf;
call pdecimal(v,10000);
call printchar(':');
call printb;
end pv;
/* print the characteristics of the currently selected drive */
call print(.(' ',0));
call printchar(cselect+'A');
call printchar(':');
call printx(.(' Drive Characteristics',0));
rpb = shl(double(1),blkshf); /* records/block=2**blkshf */
if (rpd := (maxall+1) * rpb) = 0 and (rpb <> 0) then
call print(.('65536: ',0)); else
call pv(rpd);
call printx(.('128 Byte Record Capacity',0));
call pv(count(false));
call printx(.('Kilobyte Drive Capacity',0));
call pv(dirmax+1);
call printx(.('32 Byte Directory Entries',0));
call pv(shl(chksiz,2));
call printx(.('Checked Directory Entries',0));
call pv((extmsk+1) * 128);
call printx(.('Records/ Extent',0));
call pv(rpb);
call printx(.('Records/ Block',0));
call pv(scptrk);
call printx(.('Sectors/ Track',0));
call pv(offset);
call printx(.('Reserved Tracks',0));
call crlf;
end drivestatus;
diskstatus: procedure;
/* display disk status */
declare login address, d byte;
login = getlogin; /* login vector set */
d = 0;
do while login <> 0;
if low(login) then
do; call select$disk(d);
call drivestatus;
end;
login = shr(login,1);
d = d + 1;
end;
end diskstatus;
match: procedure(va,vl) byte;
/* return index+1 to vector at va if match */
declare va address,
v based va (16) byte,
vl byte;
declare (i,j,match,sync) byte;
j,sync = 0;
do sync = 1 to vl;
match = true;
do i = 0 to 3;
if v(j) <> accum(i) then match=false;
j = j + 1;
end;
if match then return sync;
end;
return 0; /* no match */
end match;
declare devl(*) byte data
('CON:RDR:PUN:LST:DEV:VAL:USR:DSK:');
devreq: procedure byte;
/* process device request, return true if found */
/* device tables */
declare
devr(*) byte data
(/* console */ 'TTY:CRT:BAT:UC1:',
/* reader */ 'TTY:PTR:UR1:UR2:',
/* punch */ 'TTY:PTP:UP1:UP2:',
/* listing */ 'TTY:CRT:LPT:UL1:');
declare
(i,j,iobyte,items) byte;
prname: procedure(a);
declare a address,
x based a byte;
/* print device name at a */
do while x <> ':';
call printchar(x); a=a+1;
end;
call printchar(':');
end prname;
items = 0;
do forever;
call scan;
if (i:=match(.devl,8)) = 0 then return items<>0;
items = items+1; /* found first/next item */
if i = 5 then /* device status request */
do;
iobyte = ioval; j = 0;
do i = 0 to 3;
call prname(.devl(shl(i,2)));
call printx(.(' is ',0));
call prname(.devr(shl(iobyte and 11b,2)+j));
j = j + 16; iobyte = shr(iobyte,2);
call crlf;
end;
end; else /* not dev: */
if i = 6 then /* list possible assignment */
do;
call print(.('Temp R/O Disk: d:=R/O',0));
call print(.('Set Indicator: d:filename.typ ',
'$R/O $R/W $SYS $DIR',0));
call print(.('Disk Status : DSK: d:DSK:',0));
call print(.('User Status : USR:',0));
call print(.('Iobyte Assign:',0));
do i = 0 to 3; /* each line shows one device */
call crlf;
call prname(.devl(shl(i,2)));
call printx(.(' =',0));
do j = 0 to 12 by 4;
call printchar(' ');
call prname(.devr(shl(i,4)+j));
end;
end;
end; else
if i = 7 then /* list user status values */
do; call userstatus;
return true;
end; else
if i = 8 then /* show the disk device status */
call diskstatus; else
/* scan item i-1 in device table */
do; /* find base of destination */
j = shl(i:=i-1,4);
call scan;
if accum(0) <> '=' then
do; call print(.('Bad Delimiter',0));
return true;
end;
call scan;
if (j:=match(.devr(j),4)-1) = 255 then
do; call print(.('Invalid Assignment',0));
return true;
end;
iobyte = 1111$1100b; /* construct mask */
do while (i:=i-1) <> 255;
iobyte = rol(iobyte,2);
j = shl(j,2);
end;
ioval = (ioval and iobyte) or j;
end;
/* end of current item, look for more */
call scan;
if accum(0) = ' ' then return true;
if accum(0) <> ',' then
do; call print(.('Bad Delimiter',0));
return true;
end;
end; /* of do forever */
end devreq;
pvalue: procedure(v);
declare (d,zero) byte,
(k,v) address;
k = 10000;
zero = false;
do while k <> 0;
d = low(v/k); v = v mod k;
k = k / 10;
if zero or k = 0 or d <> 0 then
do; zero = true; call printchar('0'+d);
end;
end;
call printchar('k');
call crlf;
end pvalue;
comp$alloc: procedure;
alloca = getalloca;
call printchar(cselect+'A');
call printx(.(': ',0));
end comp$alloc;
prcount: procedure;
/* print the actual byte count */
call pvalue(count(true));
end prcount;
pralloc: procedure;
/* print allocation for current disk */
call print (.('Bytes Remaining On ',0));
call comp$alloc;
call prcount;
end pralloc;
prstatus: procedure;
/* print the status of the disk system */
declare (login, rodisk) address;
declare d byte;
login = getlogin; /* login vector set */
rodisk = getrodisk; /* read only disk vector set */
d = 0;
do while login <> 0;
if low(login) then
do; call select$disk(d);
call comp$alloc;
call printx(.('R/',0));
if low(rodisk) then
call printchar('O'); else
call printchar('W');
call printx(.(', Space: ',0));
call prcount;
end;
login = shr(login,1); rodisk = shr(rodisk,1);
d = d + 1;
end;
call crlf;
end prstatus;
setdisk: procedure;
if fcb(0) <> 0 then call select$disk(fcb(0)-1);
end setdisk;
getfile: procedure;
/* process file request */
declare
fnam literally '11', fext literally '12',
fmod literally '14',
frc literally '15', fln literally '15',
fdm literally '16', fdl literally '31',
ftyp literally '9',
rofile literally '9', /* read/only file */
infile literally '10'; /* invisible file */
declare
fcbn address, /* number of fcb's collected so far */
finx(fcbmax) address, /* index vector used during sort */
fcbe(fcbmax) address, /* extent counts */
fcbb(fcbmax) address, /* byte count (mod kb) */
fcbk(fcbmax) address, /* kilobyte count */
fcbr(fcbmax) address, /* record count */
bfcba address, /* index into directory buffer */
fcbsa address, /* index into fcbs */
bfcb based bfcba (32) byte, /* template over directory */
fcbv based fcbsa (16) byte; /* template over fcbs entry */
declare
i address, /* fcb counter during collection and display */
l address, /* used during sort and display */
k address, /* " */
m address, /* " */
kb byte, /* byte counter */
lb byte, /* byte counter */
mb byte, /* byte counter */
(b,f) byte, /* counters */
matched byte; /* used during fcbs search */
multi16: procedure;
/* utility to compute fcbs address from i */
fcbsa = shl(i,4) + .fcbs;
end multi16;
declare
scase byte; /* status case # */
declare
fstatlist(*) byte data('R/O',0,'R/W',0,'SYS',0,'DIR',0);
setfilestatus: procedure byte;
/* eventually, scase set r/o=0,r/w=1,dat=2,sys=3 */
declare
fstat(*) byte data('R/O R/W SYS DIR ');
if doll = ' ' then return false;
call move(4,.parm,.accum); /* $???? */
if accum(0) = 'S' and accum(1) = ' ' then
return not (sizeset := true);
/* must be a parameter */
if (scase := match(.fstat,4)) = 0 then
call print(.('Invalid File Indicator',0));
return true;
end setfilestatus;
printfn: procedure;
declare (k, lb) byte;
/* print file name */
do k = 1 to fnam;
if (lb := fcbv(k) and 7fh) <> ' ' then
do; if k = ftyp then call printchar('.');
call printchar(lb);
end;
end;
end printfn;
call set$bpb; /* in case default disk */
call setdisk;
sizeset = false;
scase = 255;
if setfilestatus then
do; if scase = 0 then return;
scase = scase - 1;
end; else
if fcb(1) = ' ' then /* no file named */
do; call pralloc;
return;
end;
/* read the directory, collect all common file names */
fcbn,fcb(0) = 0;
fcb(fext),fcb(fmod) = '?'; /* question mark matches all */
call search(fcba); /* fill directory buffer */
collect: /* label for debug */
do while dcnt <> 255;
/* another item found, compare it for common entry */
bfcba = shl(dcnt and 11b,5)+buffa; /* dcnt mod 4 * 32 */
matched = false; i = 0;
do while not matched and i < fcbn;
/* compare current entry */
call multi16;
do kb = 1 to fnam;
if bfcb(kb) <> fcbv(kb) then kb = fnam; else
/* complete match if at end */
matched = kb = fnam;
end;
i = i + 1;
end;
checkmatched: /* label for debug */
if matched then i = i - 1; else
do; /* copy to new position in fcbs */
fcbn = (i := fcbn) + 1;
call multi16;
/* fcbsa set to next to fill */
if (fcbn > fcbmax) or (fcbsa + 16) >= memsize then
do; call print(.('** Too Many Files **',0));
i = 0; fcbn = 1;
call multi16;
end;
/* save index to element for later sort */
finx(i) = i;
do kb = 0 to fnam;
fcbv(kb) = bfcb(kb);
end;
fcbe(i),fcbb(i),fcbk(i),fcbr(i) = 0;
end;
/* entry is at, or was placed at location i in fcbs */
fcbe(i) = fcbe(i) + 1; /* extent incremented */
/* record count */
fcbr(i) = fcbr(i) + bfcb(frc)
+ (bfcb(fext) and extmsk) * 128;
/* count kilobytes */
countbytes: /* label for debug */
lb = 1;
if maxall > 255 then lb = 2; /* double precision inx */
do kb = fdm to fdl by lb;
mb = bfcb(kb);
if lb = 2 then /* double precision inx */
mb = mb or bfcb(kb+1);
if mb <> 0 then /* allocated */
call add$block(.fcbk(i),.fcbb(i));
end;
call searchn; /* to next entry in directory */
end; /* of do while dcnt <> 255 */
display: /* label for debug */
/* now display the collected data */
if fcbn = 0 then call print(.('File Not Found',0)); else
if scase = 255 then /* display collected data */
do;
/* sort the file names in ascending order */
if fcbn > 1 then /* requires at least two to sort */
do; l = 1;
do while l > 0; /* bubble sort */
l = 0;
do m = 0 to fcbn - 2;
i = finx(m+1); call multi16; bfcba = fcbsa; i = finx(m);
call multi16; /* sets fcbsa, basing fcbv */
do kb = 1 to fnam; /* compare for less or equal */
if (b:=bfcb(kb)) < (f:=fcbv(kb)) then /* switch */
do; k = finx(m); finx(m) = finx(m + 1);
finx(m + 1) = k; l = l + 1; kb = fnam;
end;
else if b > f then kb = fnam; /* stop compare */
end;
end;
end;
end;
if sizeset then
call print(.(' Size ',0)); else
call crlf;
call printx(.(' Recs Bytes Ext Acc',0));
l = 0;
do while l < fcbn;
i = finx(l); /* i is the index to next in order */
call multi16; call crlf;
/* print the file length */
call move(16,.fcbv(0),fcba);
fcb(0) = 0;
if sizeset then
do; call getfilesize(fcba);
if rovf <> 0 then call printx(.('65536',0)); else
call pdecimal(rrec,10000);
call printb;
end;
call pdecimal(fcbr(i),10000); /* rrrrr */
call printb; /* blank */
call pdecimal(fcbk(i),10000); /* bbbbbk */
call printchar('k'); call printb;
call pdecimal(fcbe(i),1000); /* eeee */
call printb;
call printchar('R');
call printchar('/');
if rol(fcbv(rofile),1) then
call printchar('O'); else
call printchar('W');
call printb;
call printchar('A'+cselect); call printchar(':');
/* print filename.typ */
if (mb:=rol(fcbv(infile),1)) then call printchar('(');
call printfn;
if mb then call printchar(')');
l = l + 1;
end;
call pralloc;
end; else
setfileatt: /* label for debug */
/* set file attributes */
do;
l = 0;
do while l < fcbn;
if break then
do; call abortmsg; return;
end;
i = l;
call multi16;
call crlf;
call printfn;
do case scase;
/* set to r/o */
fcbv(rofile) = fcbv(rofile) or 80h;
/* set to r/w */
fcbv(rofile) = fcbv(rofile) and 7fh;
/* set to sys */
fcbv(infile) = fcbv(infile) or 80h;
/* set to dir */
fcbv(infile) = fcbv(infile) and 7fh;
end;
/* place name into default fcb location */
call move(16,fcbsa,fcba);
fcb(0) = 0; /* in case matched user# > 0 */
call setind; /* indicators set */
call printx(.(' set to ',0));
call printx(.fstatlist(shl(scase,2)));
l = l + 1;
end;
end;
end getfile;
setdrivestatus: procedure;
/* handle possible drive status assignment */
call scan; /* remove drive name */
call scan; /* check for = */
if accum(0) = '=' then
do; call scan; /* get assignment */
if compare(.('R/O ')) then
do; call setdisk; /* a: ... */
call writeprot;
end; else
call print(.('Invalid Disk Assignment',0));
end;
else /* not a disk assignment */
do; call setdisk;
if match(.devl,8) = 8 then call drive$status; else
call getfile;
end;
end setdrivestatus;
/* save stack pointer and reset */
oldsp = stackptr;
stackptr = .stack(length(stack));
/* process request */
if version < cpmversion then
call print(.('Wrong CP/M Version (Requires 2.0)',0));
else
do;
/* size display if $S set in command */
ibp = 1; /* initialize buffer pointer */
if fcb(0) = 0 and fcb(1) = ' ' then /* stat only */
call prstatus; else
do;
if fcb(0) <> 0 then
call setdrivestatus; else
do;
if not devreq then /* must be file name */
call getfile;
end;
end;
end;
/* restore old stack before exit */
stackptr = oldsp;
end status;
end;


36
CPM OPERATING SYSTEMS/CPM 2.X/CPM 2.0/submit.lin Normal file
View File

@@ -0,0 +1,36 @@
0000 SUBMIT#
0000 SUB#
01DF 15 01F7 18 01FD 20 0206 21 0207 23
020D 25 0219 26 021A 27 0220 29 022C 30
022D 31 0233 33 023C 34 023D 35 0243 37
024D 38 024D 39 0253 41 025D 42 025D 43
0263 45 026F 46 0270 47 027F 50 028B 51
0295 52 029C 53 02A3 54 02A6 55 02A7 57
02AD 59 02B3 60 02B9 61 02BF 62 02C7 63
02CB 64 02CC 66 02CC 67 02D8 68 02E3 69
02EF 70 02F5 71 02FD 72 0303 73 0308 74
0309 75 0309 77 0312 79 031D 80 0320 81
0325 82 0325 83 033D 85 034B 87 0350 88
035B 90 0360 91 0362 92 0362 93 0362 94
0362 95 036C 96 0374 97 0378 98 0378 99
0378 100 0383 101 0389 102 038A 104 0481 106
0481 107 04A3 109 04A7 110 04AA 111 04AA 112
04AD 113 04AD 114 04AD 115 04BC 116 04C0 117
04C3 118 04C4 119 04C8 121 04D8 122 04DE 123
04E9 124 04F7 125 04FD 126 038A 128 0395 129
039A 130 03A1 131 03A6 132 03C1 133 03C9 135
03D1 137 03DC 138 03E6 139 03F5 140 03FE 142
0403 143 0406 144 040E 145 0412 146 0419 147
041C 148 041F 149 0422 150 0429 151 0430 152
0433 153 0433 154 0436 155 043E 157 044D 158
0456 159 045E 160 0461 161 0468 162 0468 163
046B 164 0476 165 047D 166 0480 167 04FE 168
057A 170 057A 171 0587 172 04FE 173 0504 174
0509 175 050F 176 0517 177 051D 178 0528 179
052E 180 0537 181 0542 182 054B 183 0558 184
055C 185 055F 186 0562 187 0565 188 056B 189
0573 190 0579 191 01DF 193 01E6 194 01EA 195
01ED 196 01F0 197 01F3 198 01F6 199
0000 MODULE#


294
CPM OPERATING SYSTEMS/CPM 2.X/CPM 2.0/submit.plm Normal file
View File

@@ -0,0 +1,294 @@
sub:
do;
/* modified 7/26/79 to work with cpm 2.0, module number not zero */
declare
wboot literally '0000h', /* warm start entry point */
bdos literally '0005h', /* jmp bdos */
dfcba literally '005ch', /* default fcb address */
dbuff literally '0080h'; /* default buffer address */
declare jump byte data(0c3h); /* c3 = jmp */
declare jadr address data(.submit);
/* jmp to submit is placed at the beginning of the module */
boot: procedure external;
/* system reboot */
end boot;
mon1: procedure(f,a) external;
declare f byte, a address;
/* bdos interface, no returned value */
end mon1;
mon2: procedure(f,a) byte external;
declare f byte, a address;
/* bdos interface, return byte value */
end mon2;
declare
copyright(*) byte data
(' copyright(c) 1977, digital research ');
declare
ln(5) byte initial('001 $'),
ln1 byte at(.ln(0)),
ln2 byte at(.ln(1)),
ln3 byte at(.ln(2)),
dfcb(33) byte initial(0,'$$$ SUB',0,0,0),
drec byte at(.dfcb(32)), /* current record */
buff(128) byte at(dbuff), /* default buffer */
sfcb(33) byte at(dfcba); /* default fcb */
submit: procedure;
/* t h e c p / m 's u b m i t' f u n c t i o n
copyright (c) 1976, 1977, 1978
digital research
box 579
pacific grove, ca.
93950
*/
declare lit literally 'literally',
dcl lit 'declare',
proc lit 'procedure',
addr lit 'address',
ctll lit '0ch',
lca lit '110$0001b', /* lower case a */
lcz lit '111$1010b', /* lower case z */
endfile lit '1ah'; /* cp/m end of file */
declare
true literally '1',
false literally '0',
forever literally 'while true',
cr literally '13',
lf literally '10',
what literally '63';
print: procedure(a);
declare a address;
/* print the string starting at address a until the
next dollar sign is encountered */
call mon1(9,a);
end print;
declare dcnt byte;
open: procedure(fcb);
declare fcb address;
dcnt = mon2(15,fcb);
end open;
close: procedure(fcb);
declare fcb address;
dcnt = mon2(16,fcb);
end close;
delete: procedure(fcb);
declare fcb address;
call mon1(19,fcb);
end delete;
diskread: procedure(fcb) byte;
declare fcb address;
return mon2(20,fcb);
end diskread;
diskwrite: procedure(fcb) byte;
declare fcb address;
return mon2(21,fcb);
end diskwrite;
make: procedure(fcb);
declare fcb address;
dcnt = mon2(22,fcb);
end make;
move: procedure(s,d,n);
declare (s,d) address, n byte;
declare a based s byte, b based d byte;
do while (n := n - 1) <> 255;
b = a; s = s + 1; d = d + 1;
end;
end move;
declare oldsp address; /* calling program's stack pointer */
error: procedure(a);
declare a address;
call print(.(cr,lf,'$'));
call print(.('Error On Line $'));
call print(.ln1);
call print(a);
stackptr = oldsp;
/* return to ccp */
end error;
declare sstring(128) byte, /* substitute string */
sbp byte; /* source buffer pointer (0-128) */
setup: procedure;
/* move buffer to substitute string */
call move(.buff(1),.sstring(0),127);
sstring(buff(0))=0; /* mark end of string */
call move(.('SUB'),.sfcb(9),3); /* set file type to sub */
call open(.sfcb(0));
if dcnt = 255 then
call error(.('No ''SUB'' File Present$'));
/* otherwise file is open - read subsequent data */
sbp = 128; /* causes read below */
end setup;
getsource: procedure byte;
/* read the next source character */
declare b byte;
if sbp > 127 then
do; if diskread(.sfcb(0)) <> 0 then
return endfile;
sbp = 0;
end;
if (b := buff((sbp:=sbp+1)-1)) = cr then
do; /* increment line */
if (ln3 := ln3 + 1) > '9' then
do; ln3 = '0';
if (ln2 := ln2 + 1) > '9' then
do; ln2 = '0';
ln1 = ln1 + 1;
end;
end;
end;
/* translate to upper case */
if (b-61h) < 26 then /* lower case alpha */
b = b and 5fh; /* change to upper case */
return b;
end getsource;
writebuff: procedure;
/* write the contents of the buffer to disk */
if diskwrite(.dfcb) <> 0 then /* error */
call error(.('Disk Write Error$'));
end writebuff;
declare rbuff(2048) byte, /* jcl buffer */
rbp address, /* jcl buffer pointer */
rlen byte; /* length of current command */
fillrbuff: procedure;
declare (s,ssbp) byte; /* sub string buffer pointer */
notend: procedure byte;
/* look at next character in sstring, return
true if not at the end of the string - char passed
back in 's' */
if not ((s := sstring(ssbp)) = ' ' or s = 0) then
do;
ssbp = ssbp + 1;
return true;
end;
return false;
end notend;
deblankparm: procedure;
/* clear to next non blank substitute string */
do while sstring(ssbp) = ' ';
ssbp = ssbp + 1;
end;
end deblankparm;
putrbuff: procedure(b);
declare b byte;
if (rbp := rbp + 1) > last(rbuff) then
call error(.('Command Buffer Overflow$'));
rbuff(rbp) = b;
/* len: c1 ... c125 :00:$ = 128 chars */
if (rlen := rlen + 1) > 125 then
call error(.('Command Too Long$'));
end putrbuff;
declare (reading,b) byte;
/* fill the jcl buffer */
rbuff(0),rbp = 0;
reading = true;
do while reading;
rlen = 0; /* reset command length */
do while (b:=getsource) <> endfile and b <> cr;
if b <> lf then
do; if b = '$' then /* copy substitute string */
do; if (b:=getsource) = '$' then
/* $$ replaced by $ */
call putrbuff(b); else
if (b := b - '0') > 9 then
call error(.('Parameter Error$')); else
do; /* find string 'b' in sstring */
ssbp = 0; call deblankparm; /* ready to scan sstring */
do while b <> 0; b = b - 1;
/* clear next parameter */
do while notend;
end;
call deblankparm;
end;
/* ready to copy substitute string from position ssbp */
do while notend;
call putrbuff(s);
end;
end;
end; else /* not a '$' */
if b = '^' then /* control character */
do; /* must be ^a ... ^z */
if (b:=getsource - 'a') > 25 then
call error(.('Invalid Control Character$'));
else
call putrbuff(b+1);
end; else /* not $ or ^ */
call putrbuff(b);
end;
end; /* of line or input file - compute length */
reading = b = cr;
call putrbuff(rlen); /* store length */
end;
/* entire file has been read and processed */
end fillrbuff;
makefile: procedure;
/* write resulting command file */
declare i byte;
getrbuff: procedure byte;
return rbuff(rbp := rbp - 1);
end getrbuff;
call delete(.dfcb);
drec = 0; /* zero the next record to write */
call make(.dfcb);
if dcnt = 255 then call error(.('Directory Full$'));
do while (i := getrbuff) <> 0;
/* copy i characters to buffer */
/* 00 $ at end of line gives 1.3 & 1.4 compatibility */
buff(0) = i; buff(i+1) = 00; buff(i+2) = '$';
do while i > 0;
buff(i) = getrbuff; i=i-1;
end;
/* buffer filled to $ */
call writebuff;
end;
call close(.dfcb);
if dcnt = 255 then call error(.('Cannot Close, Read/Only?$'));
end makefile;
/* enter here from the ccp with the fcb set */
declare stack(10) address; /* working stack */
oldsp = stackptr;
stackptr = .stack(length(stack));
call setup;
call fillrbuff;
call makefile;
call boot; /* reboot causes commands to be executed */
end submit;
end;


440
CPM OPERATING SYSTEMS/CPM 2.X/CPM 2.0/sysgen.asm Normal file
View File

@@ -0,0 +1,440 @@
TITLE 'SYSGEN - SYSTEM GENERATION PROGRAM 8/79'
; SYSTEM GENERATION PROGRAM, VERSION FOR MDS
VERS EQU 20 ;X.X
;
; COPYRIGHT (C) DIGITAL RESEARCH
; 1976, 1977, 1978, 1979
;
NSECTS EQU 26 ;NO. OF SECTORS PER TRACK
NTRKS EQU 2 ;NO. OF OPERATING SYSTEM TRACKS
NDISKS EQU 4 ;NUMBER OF DISK DRIVES
SECSIZ EQU 128 ;SIZE OF EACH SECTOR
LOG2SEC EQU 7 ;LOG 2 SECSIZ
SKEW EQU 1 ;SECTOR SKEW FACTOR
;
FCB EQU 005CH ;DEFAULT FCB LOCATION
FCBCR EQU FCB+32 ;CURRENT RECORD LOCATION
TPA EQU 0100H ;TRANSIENT PROGRAM AREA
LOADP EQU 900H ;LOAD POINT FOR SYSTEM DURING LOAD/STORE
BDOS EQU 5H ;DOS ENTRY POINT
BOOT EQU 0 ;JMP TO 'BOOT' TO REBOOT SYSTEM
CONI EQU 1 ;CONSOLE INPUT FUNCTION
CONO EQU 2 ;CONSOLE OUTPUT FUNCTION
SELF EQU 14 ;SELECT DISK
OPENF EQU 15 ;DISK OPEN FUNCTION
DREADF EQU 20 ;DISK READ FUNCTION
;
MAXTRY EQU 10 ;MAXIMUM NUMBER OF RETRIES ON EACH READ/WRITE
CR EQU 0DH ;CARRIAGE RETURN
LF EQU 0AH ;LINE FEED
STACKSIZE EQU 16 ;SIZE OF LOCAL STACK
;
WBOOT EQU 1 ;ADDRESS OF WARM BOOT (OTHER PATCH ENTRY
; POINTS ARE COMPUTED RELATIVE TO WBOOT)
SELDSK EQU 24 ;WBOOT+24 FOR DISK SELECT
SETTRK EQU 27 ;WBOOT+27 FOR SET TRACK FUNCTION
SETSEC EQU 30 ;WBOOT+30 FOR SET SECTOR FUNCTION
SETDMA EQU 33 ;WBOOT+33 FOR SET DMA ADDRESS
READF EQU 36 ;WBOOT+36 FOR READ FUNCTION
WRITF EQU 39 ;WBOOT+39 FOR WRITE FUNCTION
;
ORG TPA ;TRANSIENT PROGRAM AREA
JMP START
DB 'COPYRIGHT (C) 1978, DIGITAL RESEARCH '
;
; TRANSLATE TABLE - SECTOR NUMBERS ARE TRANSLATED
; HERE TO DECREASE THE SYSGEN TIME FOR MISSED SECTORS
; WHEN SLOW CONTROLLERS ARE INVOLVED. TRANSLATION TAKES
; PLACE ACCORDING TO THE "SKEW" FACTOR SET ABOVE.
;
OST: DB NTRKS ;OPERATING SYSTEM TRACKS
SPT: DB NSECTS ;SECTORS PER TRACK (CAN BE PATCHED)
TRAN: ;BASE OF TRANSLATE TABLE
TRELT SET 1 ;FIRST/NEXT TRAN ELEMENT
TRBASE SET 1 ;BASE FOR WRAPAROUND
REPT NSECTS ;ONCE FOR EACH SECTOR ON A TRACK
DB TRELT ;GENERATE FIRST/NEXT SECTOR
TRELT SET TRELT+SKEW
IF TRELT GT NSECTS
TRBASE SET TRBASE+1
TRELT SET TRBASE
ENDIF
ENDM
;
; NOW LEAVE SPACE FOR EXTENSIONS TO TRANSLATE TABLE
IF NSECTS LT 64
REPT 64-NSECTS
DB 0
ENDM
;
;
;
;
; UTILITY SUBROUTINES
MULTSEC:
;MULTIPLY THE SECTOR NUMBER IN A BY THE SECTOR SIZE
MOV L,A! MVI H,0 ;SECTOR NUMBER IN HL
REPT LOG2SEC ;LOG 2 OF SECTOR SIZE
DAD H
ENDM
RET ;WITH HL = SECTOR * SECTOR SIZE
;
GETCHAR:
; READ CONSOLE CHARACTER TO REGISTER A
MVI C,CONI! CALL BDOS!
; CONVERT TO UPPER CASE BEFORE RETURN
CPI 'A' OR 20H ! RC ;RETURN IF BELOW LOWER CASE A
CPI ('Z' OR 20H) + 1
RNC ;RETURN IF ABOVE LOWER CASE Z
ANI 5FH! RET
;
PUTCHAR:
; WRITE CHARACTER FROM A TO CONSOLE
MOV E,A! MVI C,CONO! CALL BDOS! RET
;
CRLF: ;SEND CARRIAGE RETURN, LINE FEED
MVI A,CR
CALL PUTCHAR
MVI A,LF
CALL PUTCHAR
RET
;
CRMSG: ;PRINT MESSAGE ADDRESSED BY H,L TIL ZERO
;WITH LEADING CRLF
PUSH H! CALL CRLF! POP H ;DROP THRU TO OUTMSG0
OUTMSG:
MOV A,M! ORA A! RZ
; MESSAGE NOT YET COMPLETED
PUSH H! CALL PUTCHAR! POP H! INX H
JMP OUTMSG
;
SEL:
; SELECT DISK GIVEN BY REGISTER A
MOV C,A! LHLD WBOOT! LXI D,SELDSK! DAD D! PCHL
;
TRK: ;SET UP TRACK
LHLD WBOOT ;ADDRESS OF BOOT ENTRY
LXI D,SETTRK ;OFFSET FOR SETTRK ENTRY
DAD D
PCHL ;GONE TO SETTRK
;
SEC: ;SET UP SECTOR NUMBER
LHLD WBOOT
LXI D,SETSEC
DAD D
PCHL
;
DMA: ;SET DMA ADDRESS TO VALUE OF B,C
LHLD WBOOT
LXI D,SETDMA
DAD D
PCHL
;
READ: ;PERFORM READ OPERATION
LHLD WBOOT
LXI D,READF
DAD D
PCHL
;
WRITE: ;PERFORM WRITE OPERATON
LHLD WBOOT
LXI D,WRITF
DAD D
PCHL
;
DREAD: ;DISK READ FUNCTION
MVI C,DREADF
JMP BDOS
;
OPEN: ;FILE OPEN FUNCTION
MVI C,OPENF ! JMP BDOS
;
GETPUT:
; GET OR PUT CP/M (RW=0 FOR READ, 1 FOR WRITE)
; DISK IS ALREADY SELECTED
;
LXI H,LOADP ;LOAD POINT IN RAM FOR CP/M DURING SYSGEN
SHLD DMADDR
;
; CLEAR TRACK TO 00
MVI A,-1 ;START WITH TRACK EQUAL -1
STA TRACK
;
RWTRK: ;READ OR WRITE NEXT TRACK
LXI H,TRACK
INR M ;TRACK = TRACK + 1
LDA OST ;NUMBER OF OPERATING SYSTEM TRACKS
CMP M ;= TRACK NUMBER ?
JZ ENDRW ;END OF READ OR WRITE
;
; OTHERWISE NOTDONE, GO TO NEXT TRACK
MOV C,M ;TRACK NUMBER
CALL TRK ;TO SET TRACK
MVI A,-1 ;COUNTS 0, 1, 2, . . . 25
STA SECTOR ;SECTOR INCREMENTED BEFORE READ OR WRITE
;
RWSEC: ;READ OR WRITE SECTOR
LDA SPT ;SECTORS PER TRACK
LXI H,SECTOR
INR M ;TO NEXT SECTOR
CMP M ;A=26 AND M=0 1 2...25 (USUALLY)
JZ ENDTRK ;
;
; READ OR WRITE SECTOR TO OR FROM CURRENT DMA ADDR
LXI H,SECTOR
MOV E,M ;SECTOR NUMBER
MVI D,0 ;TO DE
LXI H,TRAN
MOV B,M ;TRAN(0) IN B
DAD D ;SECTOR TRANSLATED
MOV C,M ;VALUE TO C READY FOR SELECT
PUSH B ;SAVE TRAN(0),TRAN(SECTOR)
CALL SEC ;SET UP SECTOR NUMBER
POP B ;RECALL TRAN(0),TRAN(SECTOR)
MOV A,C ;TRAN(SECTOR)
SUB B ;-TRAN(0)
CALL MULTSEC ;*SECTOR SIZE
XCHG ;TO DE
LHLD DMADDR ;BASE DMA ADDRESS FOR THIS TRACK
DAD D ;+(TRAN(SECTOR)-TRAN(0))*SECSIZ
MOV B,H
MOV C,L ;TO BC FOR SEC CALL
CALL DMA ;DMA ADDRESS SET FROM B,C
; DMA ADDRESS SET, CLEAR RETRY COUNT
XRA A
STA RETRY ;SET TO ZERO RETRIES
;
TRYSEC: ;TRY TO READ OR WRITE CURRENT SECTOR
LDA RETRY
CPI MAXTRY ;TOO MANY RETRIES?
JC TRYOK
;
; PAST MAXTRIES, MESSAGE AND IGNORE
LXI H,ERRMSG
CALL OUTMSG
CALL GETCHAR
CPI CR
JNZ REBOOT
;
; TYPED A CR, OK TO IGNORE
CALL CRLF
JMP RWSEC
;
TRYOK:
; OK TO TRY READ OR WRITE
INR A
STA RETRY ;RETRY=RETRY+1
LDA RW ;READ OR WRITE?
ORA A
JZ TRYREAD
;
; MUST BE WRITE
CALL WRITE
JMP CHKRW ;CHECK FOR ERROR RETURNS
TRYREAD:
CALL READ
CHKRW:
ORA A
JZ RWSEC ;ZERO FLAG IF R/W OK
;
; ERROR, RETRY OPERATION
JMP TRYSEC
;
; END OF TRACK
ENDTRK:
LDA SPT ;SECTORS PER TRACK
CALL MULTSEC ;*SECSIZ
XCHG ;TO DE
LHLD DMADDR ;BASE DMA FOR THIS TRACK
DAD D ;+SPT*SECSIZ
SHLD DMADDR ;READY FOR NEXT TRACK
JMP RWTRK ;FOR ANOTHER TRACK
;
ENDRW: ;END OF READ OR WRITE, RETURN TO CALLER
RET
;
;
START:
;
LXI SP,STACK ;SET LOCAL STACK POINTER
LXI H,SIGNON
CALL OUTMSG
;
; CHECK FOR DEFAULT FILE LOAD INSTEAD OF GET
;
LDA FCB+1 ;BLANK IF NO FILE
CPI ' '
JZ GETSYS ;SKIP TO GET SYSTEM MESSAGE IF BLANK
LXI D,FCB ;TRY TO OPEN IT
CALL OPEN ;
INR A ;255 BECOMES 00
JNZ RDOK ;OK TO READ IF NOT 255
;
; FILE NOT PRESENT, ERROR AND REBOOT
;
LXI H,NOFILE
CALL CRMSG
JMP REBOOT
;
; FILE PRESENT
; READ TO LOAD POINT
;
RDOK:
XRA A
STA FCBCR ;CURRENT RECORD = 0
;
; PRE-READ AREA FROM TPA TO LOADP
;
MVI C,(LOADP-TPA)/SECSIZ
; PRE-READ FILE
PRERD:
PUSH B ;SAVE COUNT
LXI D,FCB ;INPUT FILE CONTROL COUNT
CALL DREAD ;ASSUME SET TO DEFAULT BUFFER
POP B ;RESTORE COUNT
ORA A
JNZ BADRD ;CANNOT ENCOUNTER END-OF FILE
DCR C ;COUNT DOWN
JNZ PRERD ;FOR ANOTHER SECTOR
;
; SECTORS SKIPPED AT BEGINNING OF FILE
;
LXI H,LOADP
RDINP:
PUSH H
MOV B,H
MOV C,L ;READY FOR DMA
CALL DMA ;DMA ADDRESS SET
LXI D,FCB ;READY FOR READ
CALL DREAD ;
POP H ;RECALL DMA ADDRESS
ORA A ;00 IF READ OK
JNZ PUTSYS ;ASSUME EOF IF NOT.
; MORE TO READ, CONTINUE
LXI D,SECSIZ
DAD D ;HL IS NEW LOAD ADDRESS
JMP RDINP
;
BADRD: ;EOF ENCOUNTERED IN INPUT FILE
LXI H,BADFILE
CALL CRMSG
JMP REBOOT
;
;
GETSYS:
LXI H,ASKGET ;GET SYSTEM?
CALL CRMSG
CALL GETCHAR
CPI CR
JZ PUTSYS ;SKIP IF CR ONLY
;
SUI 'A' ;NORMALIZE DRIVE NUMBER
CPI NDISKS ;VALID DRIVE?
JC GETC ;SKIP TO GETC IF SO
;
; INVALID DRIVE NUMBER
CALL BADDISK
JMP GETSYS ;TO TRY AGAIN
;
GETC:
; SELECT DISK GIVEN BY REGISTER A
ADI 'A'
STA GDISK ;TO SET MESSAGE
SUI 'A'
CALL SEL ;TO SELECT THE DRIVE
; GETSYS, SET RW TO READ AND GET THE SYSTEM
CALL CRLF
LXI H,GETMSG
CALL OUTMSG
CALL GETCHAR
CPI CR
JNZ REBOOT
CALL CRLF
;
XRA A
STA RW
CALL GETPUT
LXI H,DONE
CALL OUTMSG
;
; PUT SYSTEM
PUTSYS:
LXI H,ASKPUT
CALL CRMSG
CALL GETCHAR
CPI CR
JZ REBOOT
SUI 'A'
CPI NDISKS
JC PUTC
;
; INVALID DRIVE NAME
CALL BADDISK
JMP PUTSYS ;TO TRY AGAIN
;
PUTC:
; SET DISK FROM REGISTER C
ADI 'A'
STA PDISK ;MESSAGE SET
SUI 'A'
CALL SEL ;SELECT DEST DRIVE
; PUT SYSTEM, SET RW TO WRITE
LXI H,PUTMSG
CALL CRMSG
CALL GETCHAR
CPI CR
JNZ REBOOT
CALL CRLF
;
LXI H,RW
MVI M,1
CALL GETPUT ;TO PUT SYSTEM BACK ON DISKETTE
LXI H,DONE
CALL OUTMSG
JMP PUTSYS ;FOR ANOTHER PUT OPERATION
;
REBOOT:
MVI A,0
CALL SEL
CALL CRLF
JMP BOOT
BADDISK:
;BAD DISK NAME
LXI H,QDISK
CALL CRMSG
RET
;
;
;
; DATA AREAS
; MESSAGES
SIGNON: DB 'SYSGEN VER '
DB VERS/10+'0','.',VERS MOD 10+'0'
DB 0
ASKGET: DB 'SOURCE DRIVE NAME (OR RETURN TO SKIP)',0
GETMSG: DB 'SOURCE ON '
GDISK: DS 1 ;FILLED IN AT GET FUNCTION
DB ', THEN TYPE RETURN',0
ASKPUT: DB 'DESTINATION DRIVE NAME (OR RETURN TO REBOOT)',0
PUTMSG: DB 'DESTINATION ON '
PDISK: DS 1 ;FILLED IN AT PUT FUNCTION
DB ', THEN TYPE RETURN',0
ERRMSG: DB 'PERMANENT ERROR, TYPE RETURN TO IGNORE',0
DONE: DB 'FUNCTION COMPLETE',0
QDISK: DB 'INVALID DRIVE NAME (USE A, B, C, OR D)',0
NOFILE: DB 'NO SOURCE FILE ON DISK',0
BADFILE:
DB 'SOURCE FILE INCOMPLETE',0
;
; VARIABLES
SDISK: DS 1 ;SELECTED DISK FOR CURRENT OPERATION
TRACK: DS 1 ;CURRENT TRACK
SECTOR: DS 1 ;CURRENT SECTOR
RW: DS 1 ;READ IF 0, WRITE IF 1
DMADDR: DS 2 ;CURRENT DMA ADDRESS
RETRY: DS 1 ;NUMBER OF TRIES ON THIS SECTOR
DS STACKSIZE*2
STACK:
END


117
CPM OPERATING SYSTEMS/CPM 2.X/CPM 2.0/xsub0.asm Normal file
View File

@@ -0,0 +1,117 @@
version equ 20h
; xsub relocator program, included with the module
; to perform the move from 200h to the destination address
;
; copyright (c) 1979
; digital research
; box 579
; pacific grove, ca.
; 93950
;
org 100h
db (lxi or (b shl 3)) ;lxi b,module size
org $+2 ;skip address field
jmp start
db ' Extended Submit Vers '
db version/16+'0','.',version mod 16+'0'
db ', Copyright (c) 1979, Digital Research '
nogo: db 'Extended Submit Already Present$'
badver: db 'Requires CP/M Version 2.0 or later$'
;
bdos equ 0005h ;bdos entry point
print equ 9 ;bdos print function
vers equ 12 ;get version number
ccplen equ 0800h ;size of ccp
module equ 200h ;module address
;
start:
; ccp's stack used throughout
push b ;save the module's length
lda bdos+1 ;xsub already present?
cpi 06h ;low address must be 06h
jz continue
;
; bdos is not lowest module in memory, return to ccp
mvi c,print
lxi d,nogo ;already present message
call bdos ;to print the message
pop b ;recall length
ret ;to the ccp
;
continue:
mvi c,vers
call bdos ;version number?
cpi version ;2.0 or greater
jnc versok
;
; wrong version
mvi c,print
lxi d,badver
call bdos
pop b
ret ;to ccp
;
versok:
lxi h,bdos+2;address field of jump to bdos (top memory)
mov a,m ;a has high order address of memory top
dcr a ;page directly below bdos
sui (ccplen shr 8) ;-ccp pages
pop b ;recall length of module
push b ;and save it again
sub b ;a has high order address of reloc area
mov d,a
mvi e,0 ;d,e addresses base of reloc area
push d ;save for relocation below
;
lxi h,module;ready for the move
move: mov a,b ;bc=0?
ora c
jz reloc
dcx b ;count module size down to zero
mov a,m ;get next absolute location
stax d ;place it into the reloc area
inx d
inx h
jmp move
;
reloc: ;storage moved, ready for relocation
; hl addresses beginning of the bit map for relocation
pop d ;recall base of relocation area
pop b ;recall module length
push h ;save bit map base in stack
mov h,d ;relocation bias is in d
;
rel0: mov a,b ;bc=0?
ora c
jz endrel
;
; not end of the relocation, may be into next byte of bit map
dcx b ;count length down
mov a,e
ani 111b ;0 causes fetch of next byte
jnz rel1
; fetch bit map from stacked address
xthl
mov a,m ;next 8 bits of map
inx h
xthl ;base address goes back to stack
mov l,a ;l holds the map as we process 8 locations
rel1: mov a,l
ral ;cy set to 1 if relocation necessary
mov l,a ;back to l for next time around
jnc rel2 ;skip relocation if cy=0
;
; current address requires relocation
ldax d
add h ;apply bias in h
stax d
rel2: inx d ;to next address
jmp rel0 ;for another byte to relocate
;
endrel: ;end of relocation
pop d ;clear stacked address
; h has the high order 8-bits of relocated module address
mvi l,0
pchl ;go to relocated program
end


176
CPM OPERATING SYSTEMS/CPM 2.X/CPM 2.0/xsub1.asm Normal file
View File

@@ -0,0 +1,176 @@
; xsub loads below ccp, and feeds command lines to
; programs which read buffered input
;
bias equ 0000h ;bias for relocation
base equ 0ffffh ;no intercepts below here
wboot equ 0000h
bdos equ 0005h
bdosl equ bdos+1
dbuff equ 0080h
;
cr equ 0dh ;carriage return
lf equ 0ah ;line feed
modnum equ 14 ;module number position
pbuff equ 9 ;print buffer
rbuff equ 10 ;read buffer
openf equ 15 ;open file
closef equ 16 ;close file
delf equ 19 ;delete file
dreadf equ 20 ;disk read
dmaf equ 26 ;set dma function
;
;
org 0000h+bias
; initialize jmps to include xsub module
lxi h,wstart
shld wboot+1
lhld bdosl
shld rbdos+1 ;real bdos entry
lxi h,trap ;address to fill
shld bdosl ;jmp @0005 leads to trap
pop h ;ccp return address
shld ccpret
pchl ;back to ccp
;
rbdos: jmp 0000h ;filled in at initialization
;
wstart:
lxi sp,stack
mvi c,pbuff ;print message
lxi d,actmsg
call rbdos
lxi h,dbuff ;restore default buffer
shld udma
lxi h,trap
shld bdosl ;fixup low jump address
lhld ccpret ;back to ccp
pchl
actmsg: db cr,lf,'(xsub active)$'
;
trap: ;arrive here at each bdos call
pop h ;return address
push h ;back to stack
mov a,h ;high address
cpi base shr 8
jnc rbdos ;skip calls on bdos above here
mov a,c ;function number
cpi rbuff
jz rnbuff ;read next buffer
cpi dmaf ;set dma address?
jnz rbdos ;skip if not
xchg ;dma to hl
shld udma ;save it
xchg
jmp rbdos
;
setdma:
mvi c,dmaf
lxi d,combuf
call rbdos
ret
;
rsetdma:
mvi c,dmaf
lhld udma
xchg
call rbdos
ret
;
fbdos:
push b
push d
call setdma
pop d
pop b
call rbdos
push psw
call rsetdma
pop psw
ret
;
cksub: ;check for sub file present
mvi c,openf
lxi d,subfcb
call fbdos ;submit file present?
inr a ;00 if not present
ret
;
rnbuff:
push d ;command address
call cksub ;sub file present?
pop d
mvi c,rbuff
jz rbdos ;no sub file now
;
push d
lda subrc ;length of file
ora a ;zero?
jz rbdos ;skip if so
dcr a ;length - 1
sta subcr ;next to read
mvi c,dreadf
lxi d,subfcb
call fbdos ;read record
; now print the buffer with cr,lf
lxi h,combuf
mov e,m ;length
mvi d,0 ;high order 00
dad d ;to last character position
inx h
mvi m,cr
inx h
mvi m,lf
inx h
mvi m,'$'
mvi c,pbuff
lxi d,combuf+1
call rbdos ;to print it
pop h ;.max length
lxi d,combuf
ldax d ;how long?
cmp m ;cy if ok
jc movlin
mov a,m ;max length
stax d ;truncate length
movlin:
mov c,a ;length to c
inr c ;+1
inx h ;to length of line
rdloop:
ldax d ;next char
mov m,a
inx h
inx d
dcr c
jnz rdloop ;loop til copied
mvi c,closef
lxi d,subfcb
lxi h,modnum
dad d ;hl=fcb(modnum)
mvi m,0 ;=0 so acts as if written
lda subcr ;length of file
dcr a ;incremented by read op
sta subrc ;decrease file length
ora a ;at zero?
jnz fileop
mvi c,delf ;delete if at end
fileop: call fbdos
ret
;
subfcb:
db 1 ;a:
db '$$$ '
db 'SUB'
db 0,0,0
subrc:
ds 1
ds 16 ;map
subcr: ds 1
;
combuf: ds 131
udma: dw dbuff
ccpret: ds 2 ;ccp return address
ds 32 ;16 level stack
stack:
end