|
DataMuseum.dkPresents historical artifacts from the history of: Bogika Butler |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Bogika Butler Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - 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»