home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.barnyard.co.uk
/
2015.02.ftp.barnyard.co.uk.tar
/
ftp.barnyard.co.uk
/
cpm
/
walnut-creek-CDROM
/
MBUG
/
MBUG039.ARC
/
CPMMAC.LIB
< prev
next >
Wrap
Text File
|
1979-12-31
|
13KB
|
1,115 lines
;;Macro Library for CP/M system routines
;;(11th June, 1985)
;;
;;Macros in this library:
;;
;
;
EOF EQU 1AH
ESC EQU 1BH
CR EQU 13
LF EQU 10
TAB EQU 9
BLANK EQU 32
PERIOD EQU 46
COMMA EQU 44
;
VERSN MACRO NUM
;;
LOCAL AROUND
JMP AROUND
DB 'Ver',NUM
AROUND:
ENDM
;
ENTER MACRO
LXI H,0
DAD SP
SHLD OLDSTK
LXI SP,STACK
ENDM
;
EXIT MACRO WHERE?,SPACE?
LHLD OLDSTK
SPHL
IF NUL WHERE?
RET
ELSE
JMP WHERE?
ENDIF
;
OLDSTK: DS 2
IF NUL SPACE?
DS 34
ELSE
DS SPACE?
ENDIF
STACK:
ENDM
;
UCASE MACRO REG
LOCAL NOTUP?
IF NOT NUL REG
PUSH PSW
MOV A,REG
ENDIF
CPI 'Z'+7
JC NOTUP?
ANI 5FH
NOTUP?:
IF NOT NUL REG
MOV REG,A
POP PSW
ENDIF
ENDM
;
READCH MACRO REG
LOCAL AROUND
CALL RDCH?
IF NOT NUL REG
MOV REG,A
ENDIF
IF NOT CIFLAG
JMP AROUND
RDCH?: SYSF 1
CIFLAG SET TRUE
ENDIF
AROUND:
ENDM
;
FILL MACRO ADDR,BYTES,CHAR
LOCAL AROUND
PUSH H
PUSH B
IF NOT NUL ADDR
LXI H,ADDR
ENDIF
MVI C,BYTES
MVI A,CHAR
CALL FILL2?
POP B
POP H
IF NOT FLFLAG
JMP AROUND
FILL2?:
MOV M,A
INX H
DCR C
JNZ FILL2?
RET
FLFLAG SET TRUE
ENDIF
AROUND:
ENDM
;
COMPAR MACRO FIRST,SECOND,BYTES
;
LOCAL MESG,AROUND
PUSH H
PUSH D
PUSH B
IF NUL BYTES
LXI H,MESG
MVI C,AROUND-MESG
ELSE
IF NOT NUL FIRST
LXI H,FIRST
ENDIF
IF NOT NUL BYTES
MVI C,BYTES
ENDIF
ENDIF
IF NOT NUL SECOND
LXI D,SECOND
ENDIF
CALL COMP2?
POP B
POP D
POP H
IF NOT CMFLAG OR NUL BYTES
JMP AROUND
ENDIF
IF NOT CMFLAG
COMP2?:
LDAX D
CMP M
RNZ
INX H
INX D
DCR C
JNZ COMP2?
RET
CMFLAG SET TRUE
ENDIF
IF NUL BYTES
MESG: DB FIRST
ENDIF
AROUND:
ENDM
;
COMPRA MACRO FIRST,SECOND,BYTES
;
LOCAL MESG,AROUND
PUSH H
PUSH D
PUSH B
IF NUL BYTES
LXI H,MESG
MVI C,AROUND-MESG
ELSE
IF NOT NUL FIRST
LXI H,FIRST
ENDIF
IF NOT NUL C
MVI C,BYTES
ENDIF
ENDIF
IF NOT NUL SECOND
LXI D,SECOND
ENDIF
CALL COMP2?
POP B
POP D
POP H
IF NOT CMFLAG OR NUL BYTES
JMP AROUND
ENDIF
IF NOT CMFLAG
COMP2?:
LDAX D
ANI 7FH
PUSH B
MOV C,A
MOV A,M
ANI 7FH
CMP C
POP B
RNZ
INX H
INX D
DCR C
JNZ COMP2?
RET
CMFLAG SET TRUE
ENDIF
IF NUL BYTES
MESG: DB FIRST
ENDIF
AROUND:
ENDM
;
AMBIG MACRO OLD,NEW
PUSH H
PUSH D
PUSH B
LXI H,NEW+1
LXI D,OLD+1
MVI C,11
AMB2?:
MVI A,'?'
CMP M
JNZ AMB3?
LDAX D
MOV M,A
AMB3?:
INX H
INX D
DCR C
JNZ AMB2?
POP B
POP D
POP H
ENDM
;
UPPER MACRO REG
IF NOT NUL REG
PUSH PSW
MOV A,REG
ENDIF
RAR
RAR
RAR
RAR
ANI 0FH
IF NOT NUL REG
MOV REG,A
POP PSW
ENDIF
ENDM
;
SBC MACRO
SBC HL,DE
MOV A,L
SUB E
MOV L,A
MOV A,H
SBB D
MOV H,A
ENDM
;
SYSF MACRO FUNC,AE
PUSH H
PUSH D
PUSH B
MVI C,FUNC
IF NOT NUL AE
MOV E,A
PUSH PSW
CALL BDOS
POP PSW
ELSE
CALL BDOS
ENDIF
POP B
POP D
POP H
RET
ENDM
;
PCHAR MACRO PAR
LOCAL AROUND
IF NOT NUL PAR
MVI A,PAR
ENDIF
CALL PCH2?
IF NOT COFLAG
JMP AROUND
PCH2?: SYSF 2,AE
COFLAG SET TRUE
ENDIF
AROUND:
ENDM
;
CRLF MACRO
LOCAL AROUND
CALL CRLF2?
IF NOT CRFLAG
JMP AROUND
CRLF2?:
PUSH PSW
PCHAR CR
PCHAR LF
POP PSW
RET
CRFLAG SET TRUE
ENDIF
AROUND:
ENDM
;
PRINT MACRO TEXT,BYTES
LOCAL AROUND,MESG
PUSH H
PUSH B
IF NUL BYTES
LXI H,MESG
MVI B,AROUND-MESG
ELSE
IF NOT NUL TEXT
LXI H,TEXT
ENDIF
MVI B,BYTES
ENDIF
CALL PBUF?
POP B
POP H
IF NOT PRFLAG OR NUL BYTES
JMP AROUND
ENDIF
IF NOT PRFLAG
PBUF?: MOV A,M
PCHAR
INX H
DCR B
JNZ PBUF?
RET
PRFLAG SET TRUE
ENDIF
IF NUL BYTES
MESG: DB TEXT
ENDIF
AROUND:
ENDM
;
OUTHEX MACRO REG
LOCAL AROUND,HEX1?,HEX2?
IF NOT NUL REG
MOV A,REG
ENDIF
CALL OUTHX?
IF NOT CXFLAG
JMP AROUND
OUTHX?: PUSH B
MOV C,A
RAR
RAR
RAR
RAR
CALL HEX1?
MOV A,C
CALL HEX1?
MOV A,C
POP B
RET
HEX1?: ANI 0FH
ADI '0'
CPI '9'+1
JC HEX2?
ADI 'A'-'9'-1
HEX2?:
PCHAR
RET
CXFLAG SET TRUE
ENDIF
AROUND:
ENDM
;
CPMVER MACRO
PUSH H
PUSH D
PUSH B
MVI C,12
CALL BDOS
MOV A,L
POP B
POP D
POP H
ENDM
;
READB MACRO
LOCAL AROUND,RBUFM,RBUF,RBUFC,RBUFE
CALL RDB2?
IF NOT RCFLAG
JMP AROUND
RDB2?:
PUSH H
PUSH D
PUSH B
LXI D,RBUFM
MVI C,10
CALL BDOS
LXI H,RBUFM+2
SHLD RBUFM-2
POP B
POP D
POP H
RET
GETCH:
LDA RBUFC
SUI 1
RC
STA RBUFC
PUSH H
LHLD RBUFP
MOV A,M
INX H
SHLD RBUFP
POP H
RET
RCFLAG SET TRUE
RBUFP: DW RBUF
RBUFM: DB RBUFE-RBUF
RBUFC: DS 1
RBUF: DS 16
RBUFE:
ENDIF
AROUND:
ENDM
;
HEXHL MACRO
LOCAL AROUND,RDHL2,NIB?
CALL RDHL?
IF NOT HXFLAG
JMP AROUND
RDHL?:
LXI H,0
RDHL2:
CALL GETCH
CMC
RNC
UCASE
CALL NIB?
RC
DAD H
DAD H
DAD H
DAD H
ORA L
MOV L,A
JMP RDHL2
NIB?: SUI '0'
RC
CPI 'F'-'0'+1
CMC
RC
CPI 10
CMC
RNC
SUI 'A'-'9'-1
CPI 10
RET
HXFLAG SET TRUE
ENDIF
AROUND:
ENDM
;
LCHAR MACRO PAR
LOCAL AROUND
IF NOT NUL PAR
MVI A,PAR
ENDIF
CALL LCH2?
IF NOT LOFLAG
JMP AROUND
LCH2?: SYSF 5,AE
LOFLAG SET TRUE
ENDIF
AROUND:
ENDM
;
ERRORM MACRO TEXT,WHERE
CRLF
PRINT <TEXT>
IF NUL WHERE
JMP BOOT
ELSE
JMP WHERE
ENDIF
ENDM
;
OPEN MACRO POINTR,WHERE
LOCAL AROUND
LXI D,POINTR
XRA A
STA POINTR+12
STA POINTR+32
CALL OPEN2?
INR A
JNZ AROUND
IF NUL WHERE
ERRORM 'No SOURCE file',DONE
ELSE
JMP WHERE
ENDIF
IF NOT OPFLAG
OPEN2?: SYSF 15
OPFLAG SET TRUE
ENDIF
AROUND:
ENDM
;
SETDMA MACRO POINTR
LOCAL AROUND
IF NOT NUL POINTR
LXI D,POINTR
ENDIF
CALL DMA2?
IF NOT DMFLAG
JMP AROUND
DMA2?:
SYSF 26
DMFLAG SET TRUE
ENDIF
AROUND:
ENDM
;
READS MACRO POINTR,STAR
LOCAL AROUND
IF NOT NUL STAR
PCHAR STAR
ENDIF
IF NOT NUL POINTR
LXI D,POINTR
ENDIF
CALL READ2?
ORA A
IF NOT RDFLAG
JMP AROUND
READ2?: SYSF 20
RDFLAG SET TRUE
ENDIF
AROUND:
ENDM
;
GFNAME MACRO FCB
LOCAL AROUND,PNAME,ENAME,EXTEN,GNAM2
PUSH H
PUSH D
PUSH B
LXI H,FCB
SHLD FCBS?
CALL GNAM?
POP B
POP D
POP H
IF NOT FNFLAG
JMP AROUND
FCBS?: DS 2
GNAM?:
CRLF
GNAM2:
PRINT <' ',CR>
PRINT 'Enter File Name:'
LHLD FCBS?
XRA A
MOV M,A
INX H
FILL ,11,BLANK
XCHG
READB
CALL GETCH
JC GNAM2
CPI BLANK
JZ GNAM2
UCASE
STAX D
CALL GETCH
RC
CPI BLANK
RZ
MVI B,7
UCASE
CPI PERIOD
JZ ENAME
CPI ':'
JNZ PNAME
LDAX D
SUI 'A'-1
STAX D
CALL GETCH
JC GNAM2
UCASE
INR B
DCX D
PNAME:
INX D
STAX D
CALL GETCH
RC
CPI BLANK
RZ
UCASE
CPI PERIOD
JZ ENAME
DCR B
JNZ PNAME
JMP GNAM2
ENAME:
LHLD FCBS?
LXI D,9
DAD D
XCHG
MVI B,3
EXTEN:
CALL GETCH
RC
CPI BLANK
RZ
UCASE
STAX D
INX D
DCR B
JNZ EXTEN
RET
;
FNFLAG SET TRUE
ENDIF
AROUND:
ENDM
;
ABORT MACRO CHAR
LOCAL AROUND
PUSH H
PUSH D
PUSH B
MVI C,11
CALL BDOS
POP B
POP D
POP H
RRC
JNC AROUND
READCH
IF NUL CHAR
JMP DONE
ELSE
CPI CHAR
JZ DONE
ENDIF
AROUND:
ENDM
;
MAKE MACRO POINTR
LOCAL AROUND
LXI D,POINTR
XRA A
STA POINTR+12
STA POINTR+32
CALL MAKE2?
INR A
JNZ AROUND
ERRORM 'No Directory Space',DONE
IF NOT MKFLAG
MAKE2?: SYSF 22
MKFLAG SET TRUE
ENDIF
AROUND:
ENDM
;
UNPROT MACRO POINTR
LOCAL AROUND
LXI D,POINTR
LDA POINTR+9
ANI 7FH
STA POINTR+9
CALL UNPR2?
IF NOT UNFLAG
JMP AROUND
UNPR2?:
SYSF 30
UNFLAG SET TRUE
ENDIF
AROUND:
ENDM
;
PFNAME MACRO FCB
LOCAL PFNA2?,PFNA3?
PUSH H
PUSH B
MVI B,8
LXI H,FCB+1
PFNA3?:
MOV A,M
CPI BLANK
JZ PFNA2?
PCHAR
INX H
DCR B
JNC PFNA3?
PFNA2?:
POP B
POP H
PCHAR '.'
PRINT FCB+9,3
ENDM
;
DELETE MACRO POINTR,WHERE
LOCAL AROUND,DEL3?
LXI D,POINTR
LDA POINTR+9
ANI 80H
JZ DEL3?
CRLF
PFNAME POINTR
PRINT 'Is READ ONLY.Delete?'
READCH
UCASE
CPI 'Y'
IF NOT NUL WHERE
JNZ WHERE
ELSE
JNZ DONE
ENDIF
UNPROT POINTR
DEL3?:
CALL DEL2?
IF NOT DEFLAG
JMP AROUND
DEL2?:
SYSF 19
DEFLAG SET TRUE
ENDIF
AROUND:
ENDM
;
SETUP2 MACRO
LOCAL AROUND,SET2?,SET3?,SET4?
S2FLAG SET TRUE
LDA FCB2+1
CPI BLANK
JNZ SET4?
MOVE FCB1+1,FCB2+1,11
SET4?:
AMBIG FCB1,FCB2
COMPAR FCB1,FCB2,12
JZ DUPNM?
SET2?:
MOVE FCB2,DFCB,16
OPEN FCB1
OPEN DFCB,SET3?
SET3?:
DELETE DFCB
MAKE DFCB
JMP AROUND
DUPNM?:
MVI A,TRUE
STA DUPL
MOVE '$$$',FCB2+9
JMP SET2?
DUPL: DB FALSE
DFCB: DS 33
AROUND:
ENDM
;
RENAME MACRO POINTR
LOCAL AROUND,REN2?
LXI D,POINTR
LDA POINTR+9
ORI 80H
JZ REN2?
UNPROT POINTR
REN2?:
CALL RENAM?
CRLF
PRINT POINTR+1,11
PRINT '-->'
PRINT POINTR+11H,11
IF NOT RNFLAG
JMP AROUND
RENAM?: SYSF 23
RNFLAG SET TRUE
ENDIF
AROUND:
ENDM
;
WRITES MACRO POINTR,STAR
LOCAL AROUND
IF NOT NUL STAR
PCHAR STAR
ENDIF
IF NOT NUL POINTR
LXI D,POINTR
ENDIF
CALL WRIT2?
ORA A
IF WRFLAG
JNZ NROOM?
ELSE
JZ AROUND
NROOM?:
ERRORM 'No Disk Space',DONE
WRIT2?: SYSF 21
WRFLAG SET TRUE
ENDIF
AROUND:
ENDM
;
CLOSE MACRO POINTR
LOCAL AROUND,CLOSE3
IF NOT NUL POINTR
LXI D,POINTR
ENDIF
CALL CLOS2?
INR A
IF NOT S2FLAG
JNZ AROUND
ELSE
JZ CLOS3?
LDA DUPL
ORA A
JZ AROUND
MOVE 'BAK',FCB1+10H+9
MOVE FCB1+9,DFCB+10H+9,3
MOVE FCB1,FCB1+10H,9
MOVE DFCB,DFCB+10H,9
DELETE FCB1+10H
RENAME FCB1
RENAME DFCB
MOVE 'BAK',FCB1+9
OPEN FCB1
JMP AROUND
ENDIF
IF NOT CLFLAG
CLOS3?: ERRORM '?File Not Found?',DONE
CLOS2?: SYSF 16
CLFLAG SET TRUE
ENDIF
AROUND:
ENDM
;
WRFILE MACRO FCB,POINTR,STAR
LOCAL WRFIL?,EVEN?
LHLD POINTR
XCHG
LXI H,POINTR+2
SHLD POINTR
XCHG
SBC HL,DE
MOV A,L
MOV L,H
MVI H,0
DAD H
ORA A
JZ EVEN?
INX H
EVEN?:
PUSH B
MOV B,H
MOV C,L
WRFIL?:
LHLD POINTR
XCHG
SETDMA
WRITES FCB,STAR
LHLD POINTR
LXI D,80H
DAD D
SHLD POINTR
DCX B
MOV A,C
ORA B
JNZ WRFIL?
POP B
ENDM
;
PROTEC MACRO POINTR
LOCAL AROUND,PROT2?
LXI D,POINTR
LDA POINTR+9
ORI 80H
STA POINTR+9
CALL PROT2?
JMP AROUND
PROT2?:
SYSF 30
AROUND:
ENDM
;
BINBIN MACRO
LOCAL BIT2,AROUND
CALL BINB2?
IF NOT BNFLAG
JMP AROUND
BINB2?:
PUSH B
MOV C,A
MVI B,8
BIT2:
MOV A,C
ADD A
MOV C,A
MVI A,'0'/2
ADC A
PCHAR
DCR B
JNZ BIT2
POP H
RET
BNFLAG SET TRUE
ENDIF
AROUND:
ENDM
;
HLDEC MACRO
LOCAL AROUND,SUBTR,SUBT2,NZERO
CALL HLDC2?
IF NOT DEFLAG
JMP AROUND
HLDC2?:
PUSH H
PUSH D
PUSH B
MVI B,0
LXI D,-10000
CALL SUBTR
LXI D,-1000
CALL SUBTR
LXI D,-100
CALL SUBTR
LXI D,-10
CALL SUBTR
MOV A,L
ADI '0'
PCHAR
POP B
POP D
POP H
RET
SUBTR: MVI C,'0'-1
SUBT2: INR C
DAD D
JC SUBT2
SBC HL,DE
MOV A,C
CPI '1'
JNZ NZERO
MOV A,B
ORA A
MOV A,C
RZ
PCHAR
RET
NZERO:
MVI B,0FFH
PCHAR
RET
DEFLAG SET TRUE
ENDIF
AROUND:
ENDM
;
OUTHL MACRO
LOCAL OVER
MOV A,H
ORA A
JZ OVER
OUTHEX H
OVER:
OUTHEX L
ENDM
;
MULT MACRO TIMES
LOCAL LOOP,AROUND,NOTZ
PUSH B
IF NUL TIMES
MOV B,A
ELSE
MVI B,TIMES
ENDIF
CALL MULT2?
POP B
IF NOT MLFLAG
JMP AROUND
MULT2?:
MOV A,B
ORA A
JNZ NOTZ
MOV L,A
MOV H,A
RET
NOTZ:
RAR
RC
MOV B,A
LOOP:
DAD H
MOV A,B
RAR
MOV B,A
JNC LOOP
RET
MLFLAG SET TRUE
ENDIF
AROUND:
ENDM
;
DIVIDE MACRO DENOM
LOCAL AROUND,SHFTR?,DIV3?
PUSH B
IF NUL DENOM
MVI B,2
ELSE
MVI B,DENOM
ENDIF
CALL DIV2?
POP B
IF NOT DVFLAG
JMP AROUND
DIV2?:
MOV A,B
ORA A
RZ
RAR
RC
MOV B,A
DIV3?:
CALL SHFTR?
MOV A,B
RAR
MOV B,A
JNC DIV3?
RET
SHFTR?:
XRA A
MOV A,H
RAR
MOV H,A
MOV A,L
RAR
MOV L,A
RET
DVFLAG SET TRUE
ENDIF
AROUND:
ENDM
;
FILLD MACRO ADDR,BYTES,CHAR
LOCAL AROUND,FILL3?
PUSH H
PUSH B
IF NOT NUL ADDR
LXI H,ADDR
ENDIF
IF NOT NUL BYTES
LXI B,BYTES
ENDIF
MVI A,CHAR
CALL FILL2?
POP B
POP H
IF NOT FLFLAG
JMP AROUND
FILL2?:
PUSH D
MOV D,A
FILL3?:
MOV M,D
INX H
DCX B
MOV A,C
ORA B
JNZ FILL3?
POP D
RET
FLFLAG SET TRUE
ENDIF
AROUND:
ENDM
;
; THAT IS THE LAST OF THOSE 'ORRIBLE MACRO'S THAT
; I GREW VERY WEARY OF TYPING. YEEEAAAAHHHH!
MOVE MACRO FROM,TO,BYTES
LOCAL AROUND,MESG
PUSH H
PUSH D
PUSH B
IF NOT NUL TO
LXI D,TO
ENDIF
IF NUL BYTES
LXI H,MESG
LXI B,AROUND-MESG
ELSE
IF NOT NUL FROM
LXI H,FROM
ENDIF
LXI B,BYTES
ENDIF
CALL MOVE2?
POP B
POP D
POP H
IF NOT MVFLAG OR NUL BYTES
JMP AROUND
ENDIF
IF NOT MVFLAG
MOVE2?:
MOV A,M
STAX D
INX H
INX D
DCX B
MOV A,C
ORA B
JNZ MOVE2?
RET
MVFLAG SET TRUE
ENDIF
IF NUL BYTES
MESG:
DB FROM
ENDIF
AROUND:
ENDM
;
; END OF TEXT