|
DataMuseum.dkPresents historical artifacts from the history of: CP/M |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about CP/M Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 9472 (0x2500)
Types: TextFile
Names: »EXAMPLE.MAC«
└─⟦832e7e234⟧ Bits:30003263 Butler systemdiskette
└─⟦832e7e234⟧ Bits:30004286 Butler systemdiskette
└─⟦this⟧ »EXAMPLE.MAC«
└─⟦ccbc2d84d⟧ Bits:30004597 Boot 60k CP/M (Butler)
└─⟦this⟧ »EXAMPLE.MAC«
└─⟦d823d3189⟧ Bits:30004365 Butler CP/M 2.2 systemdiskette fra LFU
└─⟦this⟧ »EXAMPLE.MAC«
NAME ('EXAMPLE')
;
; This is an example of a file which defines "EXTENSIONS"
; to the METANIC COMAL-80 interpreter version 2.
; The file is intentioned for use with the MACRO-80 macro
; assembler from Microsoft.
;
; Version 1 written 830324
; by Arne Christensen
; who is of Metanic ApS
; Kongevejen 177
; DK-2830 Virum
; Denmark
;
.Z80
.XLIST
;
; Macro definitions used when writing "EXTENSIONS" to the
; METANIC COMAL-80 interpreter version 2.
; The macro definitions are intentioned for use with the
; MACRO-80 macro assembler from Microsoft.
;
; Version 1 written 830324
; by Arne Christensen
; who is of Metanic ApS
; Kongevejen 177
; DK-2830 Virum
; Denmark
;
SETNAME MACRO NAME
@&NAME EQU @NO
@NO DEFL @NO+1
ENDM
SKIP MACRO AMOUNT
@NO DEFL @NO+AMOUNT
ENDM
DEF0 MACRO NAMES
IRP Y,<NAMES>
SETNAME Y
Y MACRO
DB @&Y
ENDM
ENDM
ENDM
DEF1 MACRO NAMES
IRP Y,<NAMES>
SETNAME Y
Y MACRO PARAM
DB @&Y,PARAM
ENDM
ENDM
ENDM
@NO DEFL 0
DEF0 <ATN,COS,SIN,TAN,LOG,EXP,SQR,ESC,ERR,EOD>
DEF0 <EOF,LEN,ORD,IVAL,VAL,INT,FRAC,TRUNC,ROUND>
DEF0 <POS,BVAL,CHR,STR,I.STR,ERRTEXT,SGN,I.SGN>
DEF0 <ABS,I.ABS,RND0,RND2,SPC,PEEK,INP,BSTR,VARPTR>
SKIP 6
DEF0 <FREEST>
DEF0 <ENDEXPR,CONV1,CONV,REALINT,RLBL1,RLBL>
SKIP 5
DEF1 <INX>
SKIP 2
DEF0 <LDVAL>
DEF1 <SYSVAR>
@X DEFL 0
IRP Y,<ZONE,INDENT,PAGEWI,PAGELE,KWLOWER,IDLOWER>
Y EQU @X
@X DEFL @X+1
ENDM
SKIP 10
SETNAME STRCON
STRCON MACRO STRING
LOCAL STREND
DB @STRCON
DW STREND-$-2
DB STRING
STREND:
ENDM
SKIP 1
SETNAME INTCON
INTCON MACRO NUMBER
DB @INTCON
DW NUMBER
ENDM
DEF0 <TRUE,FALSE>
SKIP 2
DEF0 <CHS,POWER,TIMES,SLASH,DIV,MOD,PLUS,MINUS,IN>
DEF0 <LEQ,LSS,GEQ,GTR,EQL,NEQ,B.AND,B.OR,B.NOT>
DEF0 <S.PLUS,I.TIMES,I.CHS,I.DIV,I.MOD,I.PLUS,I.MINUS>
DEF0 <I.LEQ,I.LSS,I.GEQ,I.GTR,I.EQL,I.NEQ>
DEF0 <S.LEQ,S.LSS,S.GEQ,S.GTR,S.EQL,S.NEQ>
DEF0 <UROUND>
DEF1 <LOAD,STORE>
DEF0 <STVAL>
EXPR MACRO
CALL 103H
ENDM
INTREAL EQU 1
INT EQU 2
REAL EQU 3
STR EQU 4
ANYTYPE EQU 9
ANYDIM EQU -3
DEFPRIORITY MACRO PRIORITY,NAMES
IRP Y,<NAMES>
@@&Y EQU PRIORITY
ENDM
ENDM
DEFPRIORITY 7,<ARROW>
DEFPRIORITY 6,<TIMES,SLASH,DIV,MOD>
DEFPRIORITY 5,<PLUS,MINUS,CHS>
DEFPRIORITY 4,<LEQ,LSS,GEQ,GTR,EQL,NEQ,IN>
DEFPRIORITY 3,<B.NOT>
DEFPRIORITY 2,<B.AND>
DEFPRIORITY 1,<B.OR>
EXTENSION MACRO NAME,USENAM
LOCAL NAMEEND
IFB <USENAM>
DW ?&NAME
DS 1
DW NAME
ELSE
DW ?&USENAM
DS 1
DW USENAM
ENDIF
DB NAMEEND-$-1
DB '&NAME'
NAMEEND:
ENDM
OPERATOR MACRO X1,X2,X3,X4
IFB <X4> ;; UNARY OPERATOR
DEFB 80H+X1,0,X2,@@&X3
ELSE
DEFB 80H+X1,X2,X3,@@&X4
ENDIF
@OPER DEFL 1
ENDM
FUNCTION MACRO TYPE
DB TYPE
@OPER DEFL 0
ENDM
STATEMENT MACRO
DB 0
@OPER DEFL 0
ENDM
PARAMETER MACRO X1,X2
IFB <X2> ;; VALUE
DB -1,X1
ELSE
DB X1,X2
ENDIF
ENDM
ENDEXT MACRO NAME,USENAM
IFF @OPER
DB -2
ENDIF
IFB <USENAM>
?&NAME:
ELSE
?&USENAM:
ENDIF
ENDM
ENDALLEXT MACRO NAME,USENAM
IFF @OPER
DB -2
ENDIF
IFB <USENAM>
?&NAME EQU 0
ELSE
?&USENAM EQU 0
ENDIF
ENDM
.LIST
.SALL
;
; Comments are in a COMAL-80-like style, while
; routine headings are in a Pascal-like style.
;
;
; Interface descriptions for the "EXTENSIONS" defined in
; this file:
;
EXTENSION BIT,BIT00
OPERATOR INT,INT,INTREAL,IN
ENDEXT BIT,BIT00
EXTENSION SETBIT
STATEMENT
PARAMETER 0,INT
PARAMETER INTREAL
PARAMETER INTREAL
ENDEXT SETBIT
EXTENSION COMPL
OPERATOR INT,INT,CHS
ENDEXT COMPL
EXTENSION HEX
FUNCTION STR
PARAMETER REAL
ENDEXT HEX
EXTENSION LOWBOUND
FUNCTION INT
PARAMETER ANYDIM,ANYTYPE
PARAMETER INTREAL
ENDEXT LOWBOUND
EXTENSION HIGHBOUND
FUNCTION INT
PARAMETER ANYDIM,ANYTYPE
PARAMETER INTREAL
ENDEXT HIGHBOUND
EXTENSION MAXLENGTH
FUNCTION INT
PARAMETER 0,STR
ENDALLEXT MAXLENGTH
;
; OPERATOR BIT(NUMBER : INT; POS : REALINT) : INT
;
; Returns the value of bit number POS in NUMBER.
;
BIT00:
LD A,(IX+1) ; IF POS > 15
AND 0F0H
OR (IX+2) ; OR POS < 0
OR (IX+0) ; OR POS HAS OVERFLOWED
JR Z,BIT10 ; THEN
LD A,84 ; A := 84; CY := 0; Z := 0
AND A
JR BIT90 ; ELSE
BIT10: LD A,(IX+1) ; IF POS < 8 THEN
CP 8
JR NC,BIT20
LD B,A ; B := POS
LD A,(IX+3) ; A := LOW BYTE OF NUMBER
JR BIT30 ; ELSE
BIT20: SUB 8
LD B,A ; B := POS-8
LD A,(IX+3+1) ; A := HIGH BYTE OF NUMBER
BIT30: ; ENDIF
INC B ; ROTATE A RIGHT B+1 TIMES
BIT40: RRCA ; CY := LAST BIT SHIFTED OUT
DJNZ BIT40
LD A,0
ADC A,A
LD B,A ; B := CY
XOR A ; A := 0; CY := 0; Z := 1
BIT90: ; ENDIF
INC IX ; // ADJUST IX
INC IX
INC IX
LD (IX+0),B ; RETURN B, A,CY,Z
LD (IX+1),0
RET
;
; STATEMENT SETBIT(VAR VARIABLE : INT; POS, VALUE : INTREAL)
;
; Sets bit number POS in VARIABLE to VALUE. If VALUE <> 0
; the bit will be set; if VALUE = 0 the bit will be reset.
;
SETBIT:
LD A,(IX+3+1) ; IF POS > 15
AND 0F0H
OR (IX+3+2) ; OR POS < 0
OR (IX+3) ; OR POS HAS OVERFLOWED
; THEN
LD A,84 ; A := 84; CY := 0; Z := 0
JR NZ,SETB90 ; ELSE
LD A,(IX+0) ; SET := (VALUE HAS OVERFLOWED)
OR (IX+1) ; OR (VALUE <> 0)
OR (IX+2)
PUSH AF
LD L,(IX+3+3+2) ; HL := VARPTR(VARIABLE)
LD H,(IX+3+3+2+1)
LD A,(IX+3+1) ; A := POS
CP 8 ; IF A >= 8 THEN
JR C,SETB10
SUB 8 ; A :- 8; HL :+ 1
INC HL
SETB10: ; ENDIF
LD B,A
INC B
LD A,80H
SETB20: RLCA
DJNZ SETB20
LD B,A ; B := 2^A
POP AF ; IF NOT SET THEN // CLEAR
JR NZ,SETB30
LD A,B
CPL
AND (HL)
LD (HL),A ; (HL) := (HL) AND NOT B
JR SETB40 ; ELSE
SETB30: LD A,B
OR (HL)
LD (HL),A ; (HL) := (HL) OR B
SETB40: ; ENDIF
XOR A ; A := 0; CY := 0; Z := 1
SETB90: ; ENDIF
LD DE,3+3+4 ; // ADJUST IX
ADD IX,DE
RET
;
; OPERATOR COMPL(VALUE : INT) : INT
;
; Returns the one's complement of VALUE
;
COMPL:
LD A,(IX+0) ; VALUE := ONE'S COMPLEMENT OF VALUE
CPL
LD (IX+0),A
LD A,(IX+1)
CPL
LD (IX+1),A
XOR A ; A := 0; CY := 0; Z := 1
RET ; RETURN VALUE, A,CY,Z
;
; FUNCTION HEX(VALUE : REAL) : STR
;
; Converts VALUE, which must be in the range 0 to 65535
; after rounding, to a four-digit hexadecimal number.
;
HEX:
EXPR
UROUND ; NUMBER := UROUND(VALUE)
ENDEXPR ; A,CY,Z := ACCORDINGLY
JR Z,HEX10 ; IF Z=1 THEN
LD (IX+0),0
LD (IX+1),0 ; RETURN "", A,CY,Z
RET ; ELSE
HEX10: LD HL,RESULT+2 ; HL := VARPTR(RESULT)
LD A,(IX+1)
CALL HEX50 ; EXEC HEX50(HIGH BYTE OF NUMBER)
LD A,(IX+0)
CALL HEX50 ; EXEC HEX50(LOW BYTE OF NUMBER)
INC IX ; // ADJUST IX
INC IX
EXPR
INTCON RESULT
LOAD STR ; RETURN RESULT, A,CY,Z SET
ENDEXPR ; ACCORDINGLY
RET
;
; PROCEDURE HEX50(BYT : BYTE)
;
HEX50:
PUSH AF
AND 0F0H
RRCA
RRCA
RRCA
RRCA
CALL HEX60 ; EXEC HEX60(BYT DIV 16)
POP AF
AND 0FH ; EXEC HEX60(BYT MOD 16)
CALL HEX60
RET
;
; PROCEDURE HEX60(A : BYTE)
;
HEX60: ADD A,'0' ; A :+ '0'
CP '9'+1 ; IF A > '9' THEN A :+ -'0'-10+'A'
JR C,HEX70
ADD A,-'0'-10+'A'
HEX70: LD (HL),A ; (HL) := A
INC HL ; HL :+ 1
RET
RESULT: DW 4 ; RESULT IS A STRING VARIABLE
DS 4 ; WITH LENGTH 4
;
; FUNCTION LOWBOUND(VAR VARIABLE : ANYDIM&ANYTYPE ; INDEX : INTREAL) : INT
;
; Returns the lower bound on index number INDEX (1st, 2nd, 3rd etc. index)
; of the array VARIABLE.
;
LOWBOUND:
LD DE,-2
JR LOWHIGH ; RETURN LOWHIGH(VARIABLE, INDEX, -2)
;
; FUNCTION HIGHBOUND(VAR VARIABLE : ANYDIM&ANYTYPE ; INDEX : INTREAL) : INT
;
; Returns the upper bound on index number INDEX (1st, 2nd, 3rd etc. index)
; of the array VARIABLE.
;
HIGHBOUND:
LD DE,-4
JR LOWHIGH ; RETURN LOWHIGH(VARIABLE, INDEX, -4)
;
; FUNCTION LOWHIGH(VAR VARIABLE : ANYDIM&ANYTYPE : INDEX : INTREAL;
; OFFSET : INT) : INT
;
; UTILITY FUNCTION FOR LOWBOUND AND HIGHBOUND. OFFSET IS IN DE.
;
LOWHIGH:
LD L,(IX+3) ; B := THE FIRST BYTE OF VARIABLE'S
LD H,(IX+3+1) ; DESCRIPTOR
LD B,(HL)
BIT 7,B
JR Z,LOW10 ; IF B < 0 THEN
LD A,74 ; RETURN A = 74, CY = 1, Z = 0
OR A
SCF
RET
LOW10: LD A,(IX+0) ; ELIF IF INDEX HAS OVERFLOWED
OR (IX+2) ; OR INDEX < 0 OR INDEX > 255
JR NZ,LOW20
LD A,(IX+1) ; OR INDEX = 0
OR A
JR Z,LOW20
DEC A ; OR INDEX-1 > B
CP B
JR C,LOW30
JR Z,LOW30
LOW20: ; THEN
LD A,67 ; RETURN A = 67, CY = 1, Z = 0
OR A
SCF
RET ; ELSE
LOW30: LD L,(IX+3) ; HL := POINTER TO
LD H,(IX+3+1) ; VARIABLE'S DESCRIPTOR
LD BC,-7
LOW40: OR A ; HL :- (INDEX-1)*7
JR Z,LOW50
ADD HL,BC
DEC A
JR LOW40
LOW50: ADD HL,DE ; HL :+ OFFSET
LD E,(HL)
INC HL
LD D,(HL)
LD BC,3+4-2 ; // ADJUST IX
ADD IX,BC
LD (IX+0),E ; RETURN (HL), A=0, CY=0, Z=1
LD (IX+1),D
XOR A
RET ; ENDIF
;
; FUNCTION MAXLENGTH(VAR STRING : STR) : INT
;
; Returns the maximum (DIMensioned) length of the string variable STR.
;
MAXLENGTH:
LD L,(IX+0) ; HL := POINTER TO STRING'S DESCRIPTOR
LD H,(IX+1)
DEC HL
LD D,(HL)
DEC HL
LD E,(HL)
INC IX ; // ADJUST IX
INC IX
XOR A
LD (IX+0),E ; RETURN (HL-2), A=0,CY=0,Z=1
LD (IX+1),D
RET
END
«eof»