home *** CD-ROM | disk | FTP | other *** search
Text File | 1991-04-14 | 15.5 KB | 1,126 lines |
- ;***************
- ; Extenda.inc
- ; Clipper Summer87 Extend System definitions.
- ; Copyright (c) 1987, 1988 Nantucket Corp. All rights reserved.
- ;
-
-
- .XLIST
- ;.LALL
-
- $gen macro p1
- p1
- endm
-
- $err macro m
- if2
- .err
- %out (m)
- endif
- endm
-
-
- SES macro p1, p2
- $gen < MOV WORD PTR p2[2], ES>
- $gen < MOV WORD PTR p2, p1>
- endm
-
- SDS macro p1, p2
- $gen < MOV WORD PTR p2[2], DS>
- $gen < MOV WORD PTR p2, p1>
- endm
-
-
- DOSREQ macro p1
- $gen < MOV AH, p1>
- $gen < INT 021H>
- endm
-
- $define macro p1, p2, p3, p4, p5, p6, p7, p8, p9, p10, p11, p12, p13, p14
- $gen <p1 EQU p2 p3 p4 p5 p6 p7 p8 p9 p10 p11 p12 p13 p14>
- endm
-
-
- $define PCOUNT <<[WORD PTR [BP - 2]]>>
- $define OFFPART <<WORD PTR>>
- $define SEGPART <<WORD PTR [2]>>
- $define LSW <<WORD PTR>>
- $define MSW <<WORD PTR [2]>>
-
-
- $$lev = 0
- $$stat = 0
- $$work = 0
- $$cseg = 0
- $$dseg = 0
-
-
- CLextern macro p1
-
- irp $$item, <p1>
- $x_&&$$item
-
- endm
- endm
-
- $define $$UNDEF 0
- $define $$CHARACTER 1
- $define $$NUMERIC 2
- $define $$LOGICAL 4
- $define $$DATE 8
- $define $$ALIAS 16
- $define $$MPTR 32
- $define $$MEMO 65
- $define $$WORD 128
- $define $$ARRAY 512
-
- CLextern <far _parinfo, far _parinfa, far _parc, far _parcsiz, far _parclen>
- CLextern <far _parni, far _parnl, far _parnd, far _parl, far _pards>
-
- CLextern <far _retc, far _retclen, far _retni, far _retnl>
- CLextern <far _retnd, far _retl, far _retds, far _ret>
-
- $cass macro
- endm
-
- $dass macro
- endm
-
- $cseg macro p1
- if $$cseg
- $err <already have CODESEG>
-
- else
- $cbeg macro
- $gen <p1 SEGMENT BYTE PUBLIC 'CODE'>
- endm
-
- $cass macro
- $gen < ASSUME CS:&p1, DS:NOTHING, ES:NOTHING>
- endm
-
- $cend macro
- $gen <p1 ENDS>
- endm
-
- $$cseg = 1
-
- endif
- endm
-
- CODESEG macro p1
- ifnb <p1>
- $cseg p1&_TEXT
-
- else
- $result macro p2
- $cseg p2&&_TEXT
- endm
-
- $result %@fileName
- purge $result
-
- endif
- endm
-
- $dseg macro p1
- if $$dseg
- $err <already have DATASEG>
-
- else
- $gen <DGROUP GROUP p1>
-
- $dbeg macro
- $gen <p1 SEGMENT WORD PUBLIC 'DATA'>
- endm
-
- $dass macro
- $gen < ASSUME DS:DGROUP, ES:NOTHING>
- endm
-
- $dend macro
- $gen <p1 ENDS>
- endm
-
- $$dseg = 1
- endif
- endm
-
- DATASEG macro p1
- ifnb <p1>
- $dseg p1
-
- else
- $dseg _DATA
-
- endif
- endm
-
- $static macro
- if $$dseg EQ 0
- $err <STATIC w/o DATASEG>
-
- else
- if $$lev EQ 3
- $err <STATIC within CLfunc must precede CLcode>
-
- else
- if $$stat EQ 0
- $dbeg
- $dass
- $$stat = 1
- endif
-
- endif
-
- endif
- endm
-
- $endstatic macro
- if $$stat
- $dend
- $$stat = 0
- endif
- endm
-
- CLstatic macro p1
- $static
-
- ifb <p1>
- else
- irp $$item, <p1>
- $s_&&$$item
-
- endm
- endif
- endm
-
- $s_byte macro p1, p2
- $gen <p1&_BYTE$ = 1>
-
- irp $$item, <p1>
- ifdef $$item&&_PUBLIC$
- ifnb <p2>
- $gen <_&&$$item DB p2>
-
- else
- $gen <_&&$$item DB 0>
-
- endif
-
- else
- ifnb <p2>
- $gen <$$item DB p2>
-
- else
- $gen <$$item DB 0>
-
- endif
- endif
-
- endm
- endm
-
- $s_len macro p1, p2
-
- irp $$item, <p2>
- ifdef $$item&&_PUBLIC$
- $gen <p1 EQU $-_&&$$item>
-
- else
- $gen <p1 EQU $-&&$$item>
-
- endif
-
- endm
- endm
-
- $s_int macro p1, p2
- $gen <p1&_BYTE$ = 2>
-
- irp $$item, <p1>
- ifdef $$item&&_PUBLIC$
- ifnb <p2>
- $gen <_&&$$item DW p2>
-
- else
- $gen <_&&$$item DW 0>
-
- endif
-
- else
- ifnb <p2>
- $gen <$$item DW p2>
-
- else
- $gen <$$item DW 0>
-
- endif
- endif
-
- endm
- endm
-
- $s_log macro p1, p2
- $s_int p1, <p2>
- endm
-
- $s_long macro p1, p2
- $gen <p1&_BYTE$ = 4>
-
- irp $$item, <p1>
- ifdef $$item&&_PUBLIC$
- ifnb <p2>
- $gen <_&&$$item DD p2>
-
- else
- $gen <_&&$$item DD 0>
-
- endif
-
- else
- ifnb <p2>
- $gen <$$item DD p2>
-
- else
- $gen <$$item DD 0>
-
- endif
- endif
-
- endm
- endm
-
- $s_double macro p1, p2
- $gen <p1&_BYTE$ = 8>
-
- irp $$item, <p1>
- ifdef $$item&&_PUBLIC$
- ifnb <p2>
- $gen <_&&$$item DQ p2>
-
- else
- $gen <_&&$$item DQ 0>
-
- endif
-
- else
- ifnb <p2>
- $gen <$$item DQ p2>
-
- else
- $gen <$$item DQ 0>
-
- endif
- endif
-
- endm
- endm
-
- $s_cptr macro p1, p2
- $gen <p1&_BYTE$ = 4>
-
- irp $$item, <p1>
- ifdef $$item&&_PUBLIC$
- ifnb <p2>
- $gen <_&&$$item DD DGROUP:p2>
-
- else
- $gen <_&&$$item DD 0>
-
- endif
-
- else
- ifnb <p2>
- $gen <$$item DD DGROUP:p2>
-
- else
- $gen <$$item DD 0>
-
- endif
- endif
- endm
-
- $gen <p1&_OFF EQU WORD PTR p1>
- $gen <p1&_SEG EQU WORD PTR p1[2]>
- $gen <p1&_OFF_BYTE$ = 2>
- $gen <p1&_SEG_BYTE$ = 2>
-
- endm
-
- $s_string macro p1, p2
- $gen <p1&_BYTE$ = 1>
-
- irp $$item, <p1>
- ifdef $$item&&_PUBLIC$
- ifnb <p2>
- $gen <_&&$$item DB p2,0>
-
- else
- $gen <_&&$$item DB 0>
-
- endif
-
- else
- ifnb <p2>
- $gen <$$item DB p2,0>
-
- else
- $gen <$$item DB 0>
-
- endif
- endif
-
- endm
- endm
-
- WORKFUNCS macro
- if $$lev
- $err <WORKFUNCS within CLfunc/CLret>
-
- else
- if $$stat
- $endstatic
- endif
-
- if $$cseg EQ 0
- CODESEG
- endif
-
- if $$work EQ 0
- $cbeg
- $cass
- $dass
- $$work = 1
- endif
-
- endif
- endm
-
- ENDWORK macro
- if $$work
- $cend
- $$work = 0
- endif
- endm
-
- $func macro p1
- if $$stat
- $endstatic
- endif
-
- if $$work
- ENDWORK
- endif
-
- if $$cseg EQ 0
- CODESEG
- endif
-
- if $$lev
- $err <nested CLfunc>
-
- else
- $$lev = 2
-
- $entry macro
- $gen <p1 PROC FAR>
- endm
-
- $$pb = 10
- $$tb = 2
-
- $exit macro
- $gen <p1 ENDP>
- endm
-
- endif
- endm
-
- CLfunc macro p1, p2, p3
- $&p1
- $func p2
-
- $define $$pl <<p3>>
-
- ifnb <p3>
- $$lev = 2
-
- irp $$item, <p3>
- $&&$$item
-
- endm
- endif
- endm
-
- $temp macro
-
- if ($$lev GE 1) AND ($$lev LE 2)
- $$lev = 2
-
- else
- $err <CLlocal w/o CLfunc>
-
- endif
- endm
-
- CLlocal macro p1
- $temp
-
- irp $$item, <p1>
- $&&$$item
-
- endm
- endm
-
- CLcode macro
-
- if ($$lev GE 1) AND ($$lev LE 2)
- $cbeg
- $cass
- $dass
- $entry
- $gen < PUSH BP>
- $gen < PUSH SI>
- $gen < PUSH DI>
- $gen < MOV BP, SP>
-
- if $$lev EQ 2
- $result macro p4
- $gen < SUB SP, p4>
- endm
-
- $result %$$tb
- purge $result
-
- $getparam %$$pl
-
- endif
-
- purge $entry
- $$lev = 3
-
- else
- $err <CLcode w/o CLfunc>
-
- endif
- endm
-
- $getparam macro p1
- ifb <p1>
- exitm
- endif
-
- Ccall _parinfo <0>
- $gen < MOV PCOUNT, AX>
- $gen < XOR AX, AX>
-
- irp $$item, <p1>
- $gen < INC AX>
- $gen < PUSH AX>
-
- $p_&&$$item
-
- $gen < POP AX>
- endm
- endm
-
- $chktype macro p1
- $gen < PUSH AX>
-
- Ccall _parinfo <AX>
- $gen < TEST AX, p1>
-
- $gen < POP AX>
- endm
-
- $p_char macro p1
- LOCAL noparam
- $gen < MOV WORD PTR p1, 0>
- $gen < MOV WORD PTR p1[2], 0>
- $gen < CMP AX, PCOUNT>
- $gen < JA noparam>
-
- $chktype $$CHARACTER
- $gen < JZ noparam>
-
- Ccall _parc <AX>
- $gen < MOV WORD PTR p1, AX>
- $gen < MOV WORD PTR p1[2], DX>
- noparam:
- endm
-
- $p_int macro p1
- LOCAL noparam
- $gen < MOV p1, 0>
- $gen < CMP AX, PCOUNT>
- $gen < JA noparam>
-
- $chktype $$NUMERIC
- $gen < JZ noparam>
-
- Ccall _parni <AX>
- $gen < MOV p1, AX>
- noparam:
- endm
-
- $p_long macro p1
- LOCAL noparam
- $gen < MOV WORD PTR p1, 0>
- $gen < MOV WORD PTR p1[2], 0>
- $gen < CMP AX, PCOUNT>
- $gen < JA noparam>
-
- $chktype $$NUMERIC
- $gen < JZ noparam>
-
- Ccall _parnl <AX>
- $gen < MOV WORD PTR p1, AX>
- $gen < MOV WORD PTR p1[2], DX>
- noparam:
- endm
-
- $p_double macro p1
- LOCAL noparam
- $gen < MOV WORD PTR p1, 0>
- $gen < MOV WORD PTR p1[2], 0>
- $gen < MOV WORD PTR p1[4], 0>
- $gen < MOV WORD PTR p1[6], 0>
- $gen < CMP AX, PCOUNT>
- $gen < JA noparam>
-
- $chktype $$NUMERIC
- $gen < JZ noparam>
-
- Ccall _parnd <AX>
-
- $gen < PUSH ES>
- $gen < MOV ES, DX>
- $gen < MOV BX, AX>
-
- $gen < MOV AX, ES:[BX]>
- $gen < MOV WORD PTR p1, AX>
- $gen < MOV AX, ES:[BX + 2]>
- $gen < MOV WORD PTR p1[2], AX>
- $gen < MOV AX, ES:[BX + 4]>
- $gen < MOV WORD PTR p1[4], AX>
- $gen < MOV AX, ES:[BX + 6]>
- $gen < MOV WORD PTR p1[6], AX>
-
- $gen < POP ES>
- noparam:
- endm
-
- $p_log macro p1
- LOCAL noparam
- $gen < MOV p1, 0>
- $gen < CMP AX, PCOUNT>
- $gen < JA noparam>
-
- $chktype $$LOGICAL
- $gen < JZ noparam>
-
- Ccall _parl <AX>
- $gen < MOV p1, AX>
- noparam:
- endm
-
- $p_date macro p1
- LOCAL noparam
- $gen < MOV WORD PTR p1, 0>
- $gen < MOV WORD PTR p1[2], 0>
- $gen < CMP AX, PCOUNT>
- $gen < JA noparam>
-
- $chktype $$DATE
- $gen < JZ noparam>
-
- Ccall _pards <AX>
- $gen < MOV WORD PTR p1, AX>
- $gen < MOV WORD PTR p1[2], DX>
- noparam:
- endm
-
- TESTNUL macro p1
- if (p1&_BYTE$) EQ 4
- $gen < PUSH AX>
- $gen < MOV AX, WORD PTR p1>
- $gen < OR AX, WORD PTR p1[2]>
- $gen < POP AX>
-
- else
- if (p1&_BYTE$) EQ 2
- $gen < TEST p1, 0FFFFH>
-
- else
- if (p1&_BYTE$) EQ 1
- $gen < TEST p1, 0FFH>
-
- else
- $gen < PUSH AX>
- $gen < MOV AX, WORD PTR p1>
- $gen < OR AX, WORD PTR p1[2]>
- $gen < OR AX, WORD PTR p1[4]>
- $gen < OR AX, WORD PTR p1[6]>
- $gen < POP AX>
-
- endif
- endif
- endif
- endm
-
- $treg macro p1
-
- irp $$reg, <AX, BX, CX, DX, SI, DI, CS, DS, ES, SS, BP, SP>
-
- ifidni <p1>, <$$reg>
- $$isreg = 1
- exitm
- endif
-
- endm
- endm
-
- $putparam macro p1,p2
- $$q = 0
-
- irp $$item, <p1>
- $$q = $$q + 1
-
- if $$q EQ p2
- $$isreg = 0
-
- $treg <$$item>
- if $$isreg
- $$pval = $$pval + 2
- $gen < PUSH $$item>
-
- else
- ifdef $$item
- if ($$item&&_BYTE$) EQ 4
- $$pval = $$pval + 4
- $gen < PUSH WORD PTR $$item[2]>
- $gen < PUSH WORD PTR $$item>
-
- else
- if ($$item&&_BYTE$) EQ 2
- $$pval = $$pval + 2
- $gen < PUSH $$item>
-
- else
- if ($$item&&_BYTE$) EQ 1
- $$pval = $$pval + 2
- $gen < PUSH AX>
- $gen < MOV AL, $$item>
- $gen < MOV AH, 0>
- $gen < PUSH BP>
- $gen < MOV BP, SP>
- $gen < XCHG AX, [BP + 2]>
- $gen < POP BP>
-
- else
- $$pval = $$pval + 8
- $gen < PUSH WORD PTR $$item[6]>
- $gen < PUSH WORD PTR $$item[4]>
- $gen < PUSH WORD PTR $$item[2]>
- $gen < PUSH WORD PTR $$item>
-
- endif
- endif
- endif
-
- else
- $$pval = $$pval + 2
- $gen < PUSH AX>
- $gen < MOV AX, $$item>
- $gen < PUSH BP>
- $gen < MOV BP, SP>
- $gen < XCHG AX, [BP + 2]>
- $gen < POP BP>
-
- endif
- endif
-
- exitm
-
- endif
- endm
- endm
-
- Ccall macro p1,p2
- $$pval = 0
-
- ifnb <p2>
- $$param_count = 0
-
- irp $$item, <p2>
- $$param_count = $$param_count + 1
-
- endm
-
- $$param = $$param_count
-
- rept $$param_count
- $putparam <p2>,%$$param
- $$param = $$param - 1
-
- endm
- endif
-
- $gen < CALL FAR PTR p1>
-
- if $$pval
- $gen < ADD SP,$$pval>
-
- endif
- endm
-
- CLret macro p1,p2
-
- if $$lev EQ 3
-
- ifnb <p1>
- $$isreg = 0
-
- $treg p1
- if $$isreg
-
- ifnb <p2>
- if $$rb NE 4
- $err <Function return mismatch>
-
- else
- Ccall $$rf <p2, p1>
-
- endif
-
- else
- if ($$rb LT 1) OR ($$rb GT 2)
- $err <Function return mismatch>
-
- else
- Ccall $$rf <p1>
-
- endif
- endif
-
- else
- if (p1&_BYTE$) NE $$rb
- $err <Function return mismatch>
-
- else
- Ccall $$rf <p1>
-
- endif
- endif
-
- else
- if $$rb NE 0
- $err <Function return mismatch>
-
- else
- Ccall $$rf
-
- endif
- endif
-
- if $$tb
- $result macro p4
- $gen < ADD SP, p4>
- endm
-
- $result %$$tb
- purge $result
-
- endif
-
- $gen < POP DI>
- $gen < POP SI>
- $gen < POP BP>
- $gen < RET>
- $exit
- purge $exit
- $cend
-
- else
- $err <Return w/o CLfunc/CLcode>
-
- endif
-
- $$lev = 0
- endm
-
- $decl macro p1, p2, p3
-
- if $$lev EQ 1
- $result macro p4
- $gen <p1 EQU [p3 PTR [BP + p4]]>
- endm
-
- $result %$$pb
- purge $result
-
- $$pb = $$pb + p2
-
- else
- if $$lev EQ 2
- $$tb = $$tb + p2
-
- $result macro p4
- $gen <p1 EQU [p3 PTR [BP - p4]]>
- endm
-
- $result %$$tb
- purge $result
-
- else
- $err <decl w/o CLfunc>
-
- endif
- endif
-
- ifidni <p3>, <BYTE>
- $gen <p1&_BYTE$ = 1>
- else
- $gen <p1&_BYTE$ = p2>
- endif
-
- endm
-
- $void macro
- $$rb = 0
- $define $$rf <<_ret>>
- endm
-
- $char macro p1
- ifnb <p1>
- $decl p1, 4, DWORD
- else
- $$rb = 4
- $define $$rf <<_retc>>
- endif
- endm
-
- $int macro p1
- ifnb <p1>
- $decl p1, 2, WORD
- else
- $$rb = 2
- $define $$rf <<_retni>>
- endif
- endm
-
- $long macro p1
- ifnb <p1>
- $decl p1, 4, DWORD
- else
- $$rb = 4
- $define $$rf <<_retnl>>
- endif
- endm
-
- $double macro p1
- ifnb <p1>
- $decl p1, 8, QWORD
- else
- $$rb = 8
- $define $$rf <<_retnd>>
- endif
- endm
-
- $log macro p1
- ifnb <p1>
- $decl p1, 2, WORD
- else
- $$rb = 2
- $define $$rf <<_retl>>
- endif
- endm
-
- $date macro p1
- ifnb <p1>
- $decl p1, 4, DWORD
- else
- $$rb = 4
- $define $$rf <<_retds>>
- endif
- endm
-
- CLpublic macro p1
-
- irp $$item, <p1>
- $gen < PUBLIC $$item>
-
- endm
- endm
-
- Cglobal macro p1
-
- irp $$item, <p1>
- $gen < PUBLIC _&&$$item>
- $gen <$$item EQU _&&$$item>
- $gen <$$item&&_PUBLIC$ = 1>
-
- endm
- endm
-
- CLlabel macro p1
-
- irp $$item, <p1>
- $l_&&$$item
-
- endm
- endm
-
- $l_byte macro p1
- $gen <p1&_BYTE$ = 1>
-
- irp $$item, <p1>
- ifdef $$item&&_PUBLIC$
- $gen <_&&$$item LABEL BYTE>
-
- else
- $gen <$$item LABEL BYTE>
-
- endif
-
- endm
- endm
-
- $l_string macro p1
- $l_byte p1
- endm
-
- $l_int macro p1
- $gen <p1&_BYTE$ = 2>
-
- irp $$item, <p1>
- ifdef $$item&&_PUBLIC$
- $gen <_&&$$item LABEL WORD>
-
- else
- $gen <$$item LABEL WORD>
-
- endif
-
- endm
- endm
-
- $l_log macro p1
- $l_int p1
- endm
-
- $l_long macro p1
- $gen <p1&_BYTE$ = 4>
-
- irp $$item, <p1>
- ifdef $$item&&_PUBLIC$
- $gen <_&&$$item LABEL DWORD>
-
- else
- $gen <$$item LABEL DWORD>
-
- endif
-
- endm
- endm
-
- $l_double macro p1
- $gen <p1&_BYTE$ = 8>
-
- irp $$item, <p1>
- ifdef $$item&&_PUBLIC$
- $gen <_&&$$item LABEL QWORD>
-
- else
- $gen <$$item LABEL QWORD>
-
- endif
-
- endm
- endm
-
- $l_cptr macro p1
- $gen <p1&_BYTE$ = 4>
-
- irp $$item, <p1>
- ifdef $$item&&_PUBLIC$
- $gen <_&&$$item LABEL DWORD>
-
- else
- $gen <$$item LABEL DWORD>
-
- endif
- endm
-
- $gen <p1&_OFF EQU WORD PTR p1>
- $gen <p1&_SEG EQU WORD PTR p1[2]>
- $gen <p1&_OFF_BYTE$ = 2>
- $gen <p1&_SEG_BYTE$ = 2>
-
- endm
-
- $import macro p1, p2
- if $$stat
- $dend
- endif
-
- if $$lev EQ 3
- $cend
- endif
-
- $gen < EXTRN _&p1:p2>
- $gen <p1 EQU _&p1>
-
- if $$stat
- $dbeg
- endif
-
- if $$lev EQ 3
- $cbeg
- endif
-
- endm
-
- $x_byte macro p1
- $gen <p1&_BYTE$ = 2>
-
- $import p1 WORD
- endm
-
- $x_int macro p1
- $gen <p1&_BYTE$ = 2>
-
- $import p1 WORD
- endm
-
- $x_log macro p1
- $x_int p1
- endm
-
- $x_long macro p1
- $gen <p1&_BYTE$ = 4>
-
- $import p1 DWORD
- endm
-
- $x_double macro p1
- $gen <p1&_BYTE$ = 8>
-
- $import p1 QWORD
- endm
-
- $x_cptr macro p1
- $gen <p1&_BYTE$ = 4>
-
- $import p1 DWORD
- endm
-
- $x_far macro p1
- $import p1 FAR
- endm
-
-
- .LIST
-