|
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: 19840 (0x4d80)
Types: TextFile
Names: »EXAMPLE.PRN«
└─⟦832e7e234⟧ Bits:30003263 Butler systemdiskette
└─⟦832e7e234⟧ Bits:30004286 Butler systemdiskette
└─ ⟦this⟧ »EXAMPLE.PRN«
└─⟦ccbc2d84d⟧ Bits:30004597 Boot 60k CP/M (Butler)
└─ ⟦this⟧ »EXAMPLE.PRN«
└─⟦d823d3189⟧ Bits:30004365 Butler CP/M 2.2 systemdiskette fra LFU
└─ ⟦this⟧ »EXAMPLE.PRN«
\f
MACRO-80 3.4 01-Dec-80 PAGE 1
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
.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
\f
MACRO-80 3.4 01-Dec-80 PAGE 1-1
+ 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.
;
0079' BIT00:
0079' DD 7E 01 LD A,(IX+1) ; IF POS > 15
007C' E6 F0 AND 0F0H
007E' DD B6 02 OR (IX+2) ; OR POS < 0
0081' DD B6 00 OR (IX+0) ; OR POS HAS OVERFLOWED
0084' 28 05 JR Z,BIT10 ; THEN
0086' 3E 54 LD A,84 ; A := 84; CY := 0; Z := 0
0088' A7 AND A
0089' 18 1C JR BIT90 ; ELSE
008B' DD 7E 01 BIT10: LD A,(IX+1) ; IF POS < 8 THEN
008E' FE 08 CP 8
0090' 30 06 JR NC,BIT20
0092' 47 LD B,A ; B := POS
0093' DD 7E 03 LD A,(IX+3) ; A := LOW BYTE OF NUMBER
0096' 18 06 JR BIT30 ; ELSE
0098' D6 08 BIT20: SUB 8
009A' 47 LD B,A ; B := POS-8
009B' DD 7E 04 LD A,(IX+3+1) ; A := HIGH BYTE OF NUMBER
009E' BIT30: ; ENDIF
009E' 04 INC B ; ROTATE A RIGHT B+1 TIMES
009F' 0F BIT40: RRCA ; CY := LAST BIT SHIFTED OUT
00A0' 10 FD DJNZ BIT40
00A2' 3E 00 LD A,0
00A4' 8F ADC A,A
00A5' 47 LD B,A ; B := CY
00A6' AF XOR A ; A := 0; CY := 0; Z := 1
00A7' BIT90: ; ENDIF
00A7' DD 23 INC IX ; // ADJUST IX
00A9' DD 23 INC IX
00AB' DD 23 INC IX
00AD' DD 70 00 LD (IX+0),B ; RETURN B, A,CY,Z
00B0' DD 36 01 00 LD (IX+1),0
00B4' C9 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.
;
\f
MACRO-80 3.4 01-Dec-80 PAGE 1-2
00B5' SETBIT:
00B5' DD 7E 04 LD A,(IX+3+1) ; IF POS > 15
00B8' E6 F0 AND 0F0H
00BA' DD B6 05 OR (IX+3+2) ; OR POS < 0
00BD' DD B6 03 OR (IX+3) ; OR POS HAS OVERFLOWED
; THEN
00C0' 3E 54 LD A,84 ; A := 84; CY := 0; Z := 0
00C2' 20 2F JR NZ,SETB90 ; ELSE
00C4' DD 7E 00 LD A,(IX+0) ; SET := (VALUE HAS OVERFLOWED)
00C7' DD B6 01 OR (IX+1) ; OR (VALUE <> 0)
00CA' DD B6 02 OR (IX+2)
00CD' F5 PUSH AF
00CE' DD 6E 08 LD L,(IX+3+3+2) ; HL := VARPTR(VARIABLE)
00D1' DD 66 09 LD H,(IX+3+3+2+1)
00D4' DD 7E 04 LD A,(IX+3+1) ; A := POS
00D7' FE 08 CP 8 ; IF A >= 8 THEN
00D9' 38 03 JR C,SETB10
00DB' D6 08 SUB 8 ; A :- 8; HL :+ 1
00DD' 23 INC HL
00DE' SETB10: ; ENDIF
00DE' 47 LD B,A
00DF' 04 INC B
00E0' 3E 80 LD A,80H
00E2' 07 SETB20: RLCA
00E3' 10 FD DJNZ SETB20
00E5' 47 LD B,A ; B := 2^A
00E6' F1 POP AF ; IF NOT SET THEN // CLEAR
00E7' 20 06 JR NZ,SETB30
00E9' 78 LD A,B
00EA' 2F CPL
00EB' A6 AND (HL)
00EC' 77 LD (HL),A ; (HL) := (HL) AND NOT B
00ED' 18 03 JR SETB40 ; ELSE
00EF' 78 SETB30: LD A,B
00F0' B6 OR (HL)
00F1' 77 LD (HL),A ; (HL) := (HL) OR B
00F2' SETB40: ; ENDIF
00F2' AF XOR A ; A := 0; CY := 0; Z := 1
00F3' SETB90: ; ENDIF
00F3' 11 000A LD DE,3+3+4 ; // ADJUST IX
00F6' DD 19 ADD IX,DE
00F8' C9 RET
;
; OPERATOR COMPL(VALUE : INT) : INT
;
; Returns the one's complement of VALUE
;
00F9' COMPL:
00F9' DD 7E 00 LD A,(IX+0) ; VALUE := ONE'S COMPLEMENT OF VALUE
00FC' 2F CPL
00FD' DD 77 00 LD (IX+0),A
0100' DD 7E 01 LD A,(IX+1)
0103' 2F CPL
0104' DD 77 01 LD (IX+1),A
0107' AF XOR A ; A := 0; CY := 0; Z := 1
\f
MACRO-80 3.4 01-Dec-80 PAGE 1-3
0108' C9 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.
;
0109' HEX:
+ EXPR
+ UROUND ; NUMBER := UROUND(VALUE)
+ ENDEXPR ; A,CY,Z := ACCORDINGLY
010E' 28 09 JR Z,HEX10 ; IF Z=1 THEN
0110' DD 36 00 00 LD (IX+0),0
0114' DD 36 01 00 LD (IX+1),0 ; RETURN "", A,CY,Z
0118' C9 RET ; ELSE
0119' 21 0154' HEX10: LD HL,RESULT+2 ; HL := VARPTR(RESULT)
011C' DD 7E 01 LD A,(IX+1)
011F' CD 0136' CALL HEX50 ; EXEC HEX50(HIGH BYTE OF NUMBER)
0122' DD 7E 00 LD A,(IX+0)
0125' CD 0136' CALL HEX50 ; EXEC HEX50(LOW BYTE OF NUMBER)
0128' DD 23 INC IX ; // ADJUST IX
012A' DD 23 INC IX
+ EXPR
+ INTCON RESULT
+ LOAD STR ; RETURN RESULT, A,CY,Z SET
+ ENDEXPR ; ACCORDINGLY
0135' C9 RET
;
; PROCEDURE HEX50(BYT : BYTE)
;
0136' HEX50:
0136' F5 PUSH AF
0137' E6 F0 AND 0F0H
0139' 0F RRCA
013A' 0F RRCA
013B' 0F RRCA
013C' 0F RRCA
013D' CD 0147' CALL HEX60 ; EXEC HEX60(BYT DIV 16)
0140' F1 POP AF
0141' E6 0F AND 0FH ; EXEC HEX60(BYT MOD 16)
0143' CD 0147' CALL HEX60
0146' C9 RET
;
; PROCEDURE HEX60(A : BYTE)
;
0147' C6 30 HEX60: ADD A,'0' ; A :+ '0'
0149' FE 3A CP '9'+1 ; IF A > '9' THEN A :+ -'0'-10+'A'
014B' 38 02 JR C,HEX70
014D' C6 07 ADD A,-'0'-10+'A'
014F' 77 HEX70: LD (HL),A ; (HL) := A
0150' 23 INC HL ; HL :+ 1
0151' C9 RET
\f
MACRO-80 3.4 01-Dec-80 PAGE 1-4
0152' 0004 RESULT: DW 4 ; RESULT IS A STRING VARIABLE
0154' 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.
;
0158' LOWBOUND:
0158' 11 FFFE LD DE,-2
015B' 18 05 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.
;
015D' HIGHBOUND:
015D' 11 FFFC LD DE,-4
0160' 18 00 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.
;
0162' LOWHIGH:
0162' DD 6E 03 LD L,(IX+3) ; B := THE FIRST BYTE OF VARIABLE'S
0165' DD 66 04 LD H,(IX+3+1) ; DESCRIPTOR
0168' 46 LD B,(HL)
0169' CB 78 BIT 7,B
016B' 28 05 JR Z,LOW10 ; IF B < 0 THEN
016D' 3E 4A LD A,74 ; RETURN A = 74, CY = 1, Z = 0
016F' B7 OR A
0170' 37 SCF
0171' C9 RET
0172' DD 7E 00 LOW10: LD A,(IX+0) ; ELIF IF INDEX HAS OVERFLOWED
0175' DD B6 02 OR (IX+2) ; OR INDEX < 0 OR INDEX > 255
0178' 20 0C JR NZ,LOW20
017A' DD 7E 01 LD A,(IX+1) ; OR INDEX = 0
017D' B7 OR A
017E' 28 06 JR Z,LOW20
0180' 3D DEC A ; OR INDEX-1 > B
0181' B8 CP B
0182' 38 07 JR C,LOW30
0184' 28 05 JR Z,LOW30
0186' LOW20: ; THEN
0186' 3E 43 LD A,67 ; RETURN A = 67, CY = 1, Z = 0
0188' B7 OR A
0189' 37 SCF
018A' C9 RET ; ELSE
\f
MACRO-80 3.4 01-Dec-80 PAGE 1-5
018B' DD 6E 03 LOW30: LD L,(IX+3) ; HL := POINTER TO
018E' DD 66 04 LD H,(IX+3+1) ; VARIABLE'S DESCRIPTOR
0191' 01 FFF9 LD BC,-7
0194' B7 LOW40: OR A ; HL :- (INDEX-1)*7
0195' 28 04 JR Z,LOW50
0197' 09 ADD HL,BC
0198' 3D DEC A
0199' 18 F9 JR LOW40
019B' 19 LOW50: ADD HL,DE ; HL :+ OFFSET
019C' 5E LD E,(HL)
019D' 23 INC HL
019E' 56 LD D,(HL)
019F' 01 0005 LD BC,3+4-2 ; // ADJUST IX
01A2' DD 09 ADD IX,BC
01A4' DD 73 00 LD (IX+0),E ; RETURN (HL), A=0, CY=0, Z=1
01A7' DD 72 01 LD (IX+1),D
01AA' AF XOR A
01AB' C9 RET ; ENDIF
;
; FUNCTION MAXLENGTH(VAR STRING : STR) : INT
;
; Returns the maximum (DIMensioned) length of the string variable STR.
;
01AC' MAXLENGTH:
01AC' DD 6E 00 LD L,(IX+0) ; HL := POINTER TO STRING'S DESCRIPTOR
01AF' DD 66 01 LD H,(IX+1)
01B2' 2B DEC HL
01B3' 56 LD D,(HL)
01B4' 2B DEC HL
01B5' 5E LD E,(HL)
01B6' DD 23 INC IX ; // ADJUST IX
01B8' DD 23 INC IX
01BA' AF XOR A
01BB' DD 73 00 LD (IX+0),E ; RETURN (HL-2), A=0,CY=0,Z=1
01BE' DD 72 01 LD (IX+1),D
01C1' C9 RET
END
\f
MACRO-80 3.4 01-Dec-80 PAGE S
Macros:
ABS ATN B.AND B.NOT B.OR BSTR BVAL CHR
CHS CONV CONV1 COS DEF0 DEF1 DEFPRI DIV
ENDALL ENDEXP ENDEXT EOD EOF EQL ERR ERRTEX
ESC EXP EXPR EXTENS FALSE FRAC FREEST FUNCTI
GEQ GTR I.ABS I.CHS I.DIV I.EQL I.GEQ I.GTR
I.LEQ I.LSS I.MINU I.MOD I.NEQ I.PLUS I.SGN I.STR
I.TIME IN INP INT INTCON INX IVAL LDVAL
LEN LEQ LOAD LOG LSS MINUS MOD NEQ
OPERAT ORD PARAME PEEK PLUS POS POWER REALIN
RLBL RLBL1 RND0 RND2 ROUND S.EQL S.GEQ S.GTR
S.LEQ S.LSS S.NEQ S.PLUS SETNAM SGN SIN SKIP
SLASH SPC SQR STATEM STORE STR STRCON STVAL
SYSVAR TAN TIMES TRUE TRUNC UROUND VAL VARPTR
Symbols:
..0000 0009' ..0001 0019' ..0002 002C' ..0003 0039'
..0004 004B' ..0005 0060' ..0006 0075' ?BIT00 000D'
?COMPL 0030' ?HEX 003D' ?HIGHB 0066' ?LOWBO 0051'
?MAXLE 0000 ?SETBI 0021' @@ARRO 0007 @@B.AN 0002
@@B.NO 0003 @@B.OR 0001 @@CHS 0005 @@DIV 0006
@@EQL 0004 @@GEQ 0004 @@GTR 0004 @@IN 0004
@@LEQ 0004 @@LSS 0004 @@MINU 0005 @@MOD 0006
@@NEQ 0004 @@PLUS 0005 @@SLAS 0006 @@TIME 0006
@ABS 001B @ATN 0000 @B.AND 005B @B.NOT 005D
@B.OR 005C @BSTR 0022 @BVAL 0014 @CHR 0015
@CHS 004C @CONV 002D @CONV1 002C @COS 0001
@DIV 0050 @ENDEX 002B @EOD 0009 @EOF 000A
@EQL 0059 @ERR 0008 @ERRTE 0018 @ESC 0007
@EXP 0005 @FALSE 0049 @FRAC 0010 @FREES 002A
@GEQ 0057 @GTR 0058 @I.ABS 001C @I.CHS 0060
@I.DIV 0061 @I.EQL 0069 @I.GEQ 0067 @I.GTR 0068
@I.LEQ 0065 @I.LSS 0066 @I.MIN 0064 @I.MOD 0062
@I.NEQ 006A @I.PLU 0063 @I.SGN 001A @I.STR 0017
@I.TIM 005F @IN 0054 @INP 0021 @INT 000F
@INTCO 0047 @INX 0036 @IVAL 000D @LDVAL 0039
@LEN 000B @LEQ 0055 @LOAD 0072 @LOG 0004
@LSS 0056 @MINUS 0053 @MOD 0051 @NEQ 005A
@NO 0075 @OPER 0000 @ORD 000C @PEEK 0020
@PLUS 0052 @POS 0013 @POWER 004D @REALI 002E
@RLBL 0030 @RLBL1 002F @RND0 001D @RND2 001E
@ROUND 0012 @S.EQL 006F @S.GEQ 006D @S.GTR 006E
@S.LEQ 006B @S.LSS 006C @S.NEQ 0070 @S.PLU 005E
@SGN 0019 @SIN 0002 @SLASH 004F @SPC 001F
@SQR 0006 @STORE 0073 @STR 0016 @STRCO 0045
@STVAL 0074 @SYSVA 003A @TAN 0003 @TIMES 004E
@TRUE 0048 @TRUNC 0011 @UROUN 0071 @VAL 000E
@VARPT 0023 @X 0006 ANYDIM FFFD ANYTYP 0009
BIT00 0079' BIT10 008B' BIT20 0098' BIT30 009E'
BIT40 009F' BIT90 00A7' COMPL 00F9' HEX 0109'
HEX10 0119' HEX50 0136' HEX60 0147' HEX70 014F'
HIGHBO 015D' IDLOWE 0005 INDENT 0001 INT 0002
INTREA 0001 KWLOWE 0004 LOW10 0172' LOW20 0186'
LOW30 018B' LOW40 0194' LOW50 019B' LOWBOU 0158'
LOWHIG 0162' MAXLEN 01AC' PAGELE 0003 PAGEWI 0002
REAL 0003 RESULT 0152' SETB10 00DE' SETB20 00E2'
SETB30 00EF' SETB40 00F2' SETB90 00F3' SETBIT 00B5'
\f
MACRO-80 3.4 01-Dec-80 PAGE S-1
STR 0004 ZONE 0000
No Fatal error(s)
«eof»