sys7.1-doc-wip/Libs/InterfaceSrcs/PackTraps.a
2019-07-27 22:37:48 +08:00

489 lines
14 KiB
Plaintext

;
; File: PackTraps.a
;
; Contains: Implementation for Pascal-style interfaces to packages (from high-level languages).
;
; Copyright: © 1984-19902 by Apple Computer, Inc. All rights reserved.
;
; Change History (most recent first):
;
; <SM3> 10/28/92 SWC Changed INCLUDEs to a LOAD of StandardEqu.d.
; <4> 7/6/92 DCL Added Support for new synonyms.
; <3> 6/20/90 PKE Changed iuXxx selector names here to iuSelXxx to avoid potential
; name conflicts.
; <2> 1/23/90 PKE Added BBS header. Moved the implementation of several
; International Utilities routines to be inlines in Packages.h/p,
; and deleted the implementation here (controlled by
; MoveIUCallsInline flag): IUGetIntl, IUSetIntl, IUDateString,
; IUDatePString, IUTimeString, IUTimePString, IUMetric,
; IUMagString, IUMagIdString. Added glue here for IUCompPString,
; IUEqualPString, and IUStringOrder (controlled by AddIUVer7Glue
; flag). Copied iuXXX selector names from PackMacs.a and used them
; here (we can't include PackMacs.a due to name conflicts).
; <1> 1/19/90 HJR Adding for the first time into BBS.
;
; To Do:
;
;___________________________________________________________________________________________________
LOAD 'StandardEqu.d'
; Equates for INTERNATIONAL PACKAGE routine selectors <2><3>
iuSelGetIntl EQU 6
iuSelSetIntl EQU 8
iuSelDateString EQU 0
iuSelDatePString EQU 14
iuSelTimeString EQU 2
iuSelTimePString EQU 16
iuSelMetric EQU 4
iuSelMagString EQU 10
iuSelMagIDString EQU 12
iuSelLDateString EQU 20
iuSelLTimeString EQU 22
iuSelClearCache EQU 24
iuSelMagPString EQU 26
iuSelMagIDPString EQU 28
iuSelScriptOrder EQU 30
iuSelLangOrder EQU 32
iuSelTextOrder EQU 34
iuSelGetItlTable EQU 36
; The following flag indicates that we are moving the implementation of some International
; Utilities routines to inlines (see Packages.h/p) if the inlines are 3 words or less. <2>
MoveIUCallsInline EQU 1 ; <2>
; The following flag indicates that we are adding glue here for some System 7 International
; Utilities routines. <2>
AddIUVer7Glue EQU 1 ; <2>
;
;macro for package invocation
;
; first arg is routine selector, second is the trap
MACRO
PackCall
MOVE.W &SYSLIST[1],-(SP)
&SYSLIST[2]
ENDM
;
;PROCEDURE SFPutFile(where: Point; prompt: Str255; origName: Str255;
; dlgHook: ProcPtr; VAR reply: SFReply);
;
SFPutFile PROC EXPORT
EXPORT goPack
MOVEQ #1,D2 ;stuff the opcode
goPack MOVE.L (SP)+,A0 ;get user's rts
MOVE.W D2,-(SP) ;the routine selector
MOVE.L A0,-(SP) ;push the rts back on
_Pack3 autoPop ;_Pack3 w/autoPop
;never gets here
;PROCEDURE SFPPutFile(where: Point; prompt: Str255; origName: Str255;
; dlgHook: ProcPtr; VAR reply: SFReply; dlgID: INTEGER;
; filterProc: ProcPtr);
;
SFPPutFile PROC EXPORT
IMPORT goPack
MOVEQ #3,D2
JMP goPack
;
;PROCEDURE SFGetFile(where: Point; prompt: Str255; fileFilter: ProcPtr;
; numTypes: INTEGER; typeList: SFListPtr; dlgHook: ProcPtr;
; VAR reply: SFReply);
;
SFGetFile PROC EXPORT
IMPORT goPack
MOVEQ #2,D2
JMP goPack
;
;PROCEDURE SFPGetFile(where: Point; prompt: Str255; fileFilter: ProcPtr;
; numTypes: INTEGER; typeList: SFListPtr; dlgHook: ProcPtr;
; VAR reply: SFReply; dlgID: INTEGER; filterProc: ProcPtr);
;
SFPGetFile PROC EXPORT
IMPORT goPack
MOVEQ #4,D2
JMP goPack
;
;PROCEDURE DILoad;
;
DILoad PROC EXPORT
EXPORT goDI
MOVEQ #2,D2 ;stuff the opcode
goDI MOVE.L (SP)+,A0 ;get user's rts
MOVE.W D2,-(SP) ;the routine selector
MOVE.L A0,-(SP) ;push the rts back on
_Pack2 autoPop ;_Pack2 w/autoPop
;never gets here
;
;PROCEDURE DIUnLoad;
;
DIUnLoad PROC EXPORT
IMPORT goDI
MOVEQ #4,D2
JMP goDI
;
;FUNCTION DIBadMount(where: Point; evtMessage: LongInt): OsErr;
;
DIBadMount PROC EXPORT
IMPORT goDI
MOVEQ #0,D2
JMP goDI
;
;FUNCTION DIFormat(drvNum: INTEGER): OsErr;
;
DIFormat PROC EXPORT
IMPORT goDI
MOVEQ #6,D2
JMP goDI
;
;FUNCTION DIVerify(drvNum: INTEGER): OsErr;
;
DIVerify PROC EXPORT
IMPORT goDI
MOVE.W #8,D2
JMP goDI
;
;FUNCTION DIZero(drvNum: INTEGER; volName: str255): OsErr;
;
DIZero PROC EXPORT
IMPORT goDI
MOVE.W #10,D2
JMP goDI
;
;implementation of interface to International Utilities
;
IF NOT MoveIUCallsInline THEN ; <2>
;---------------
;
;FUNCTION GetIntl(theID: INTEGER): Handle;
;
GetIntl PROC EXPORT
export IUGetIntl ; obsolete old procedure name
EXPORT goINTL
IUGetIntl MOVEQ #iuSelGetIntl,D2 ;stuff the opcode
goINTL MOVE.L (SP)+,A0 ;get user's rts
MOVE.W D2,-(SP) ;the routine selector
MOVE.L A0,-(SP) ;push the rts back on
_Pack6 autoPop ;_Pack6 w/autoPop
;never gets here
;
;PROCEDURE SetIntl(refNum: INTEGER; theID: INTEGER; intlParam: Handle);
;
SetIntl PROC EXPORT
IMPORT goINTL
export IUSetIntl ; obsolete old procedure name
IUSetIntl
MOVEQ #iuSelSetIntl,D2
JMP goINTL
;
;PROCEDURE IUDateString(dateTime: LongInt; longFlag: INTEGER; VAR result: Str255);
;
IUDateString PROC EXPORT
IMPORT goINTL
MOVEQ #iuSelDateString,D2
JMP goINTL
;
;PROCEDURE DateString(dateTime: LongInt; longFlag: INTEGER; VAR result: Str255;
; intlParam: Handle);
;
DateString PROC EXPORT
IMPORT goINTL
export IUDatePString ; obsolete old procedure name
IUDatePString
MOVEQ #iuSelDatePString,D2
JMP goINTL
;
;PROCEDURE IUTimeString(dateTime: LongInt; wantSeconds: BOOLEAN; VAR result: Str255);
;
IUTimeString PROC EXPORT
IMPORT goINTL
MOVEQ #iuSelTimeString,D2
JMP goINTL
;
;PROCEDURE TimeString(dateTime: LongInt; wantSeconds: BOOLEAN; VAR result: Str255;
; intlParam: Handle);
;
TimeString PROC EXPORT
IMPORT goINTL
export IUTimePString ; obsolete old procedure name
IUTimePString
MOVEQ #iuSelTimePString,D2
JMP goINTL
;
;FUNCTION IsMetric: BOOLEAN;
;
IsMetric PROC EXPORT
IMPORT goINTL
export IUMetric ; obsolete old procedure name
IUMetric
MOVEQ #iuSelMetric,D2
JMP goINTL
;
;FUNCTION IUMagString(aPtr,bPtr: Ptr; aLen,bLen: INTEGER): INTEGER;
;
IUMagString PROC EXPORT
IMPORT goMag
MOVE.W #iuSelMagString,D2 ;the routine selector
JMP goMag
;
;FUNCTION IUMagIDString(aPtr,bPtr: Ptr; aLen,bLen: INTEGER):INTEGER;
;
IUMagIDString PROC EXPORT
EXPORT goMag
MOVE.W #iuSelMagIDString,D2 ;the routine selector
goMag MOVE.L (SP)+,A0 ;get user's rts
MOVE.W D2,-(SP) ;the routine selector
MOVE.L A0,-(SP) ;push the rts back on
_Pack6 autoPop ;_Pack6 w/autoPop
;never gets here
;---------------
ENDIF
;
;FUNCTION IUCompString(aStr,bStr: Str255): INTEGER;
;
IUCompString PROC EXPORT
IMPORT goPMag
MOVE.W #iuSelMagString,D2 ;the routine selector
JMP goPMag
;
;FUNCTION IUEqualString(aStr,bStr: Str255): INTEGER;
;
IUEqualString PROC EXPORT
EXPORT goPMag
MOVE.W #iuSelMagIDString,D2 ;the routine selector
goPMag ;first readjust the stack so that it follows the MagString/
;MagIdString string passing convention instead of Pascal's
MOVE.L 4(SP),A1 ;ptr to bStr
MOVE.L 8(SP),A0 ;ptr to aStr
CLR.W D0
CLR.W D1
MOVE.B (A0)+,D0 ;aLen
MOVE.B (A1)+,D1 ;bLen
MOVE.L A0,8(SP) ;first arg is ptr to aStr
MOVE.L A1,4(SP) ;second arg is ptr to bStr
MOVE.L (SP)+,A0 ;the return addr
MOVE.W D0,-(SP) ;third arg is aLen
MOVE.W D1,-(SP) ;fourth arg is bLen
MOVE.W D2,-(SP) ;the routine selector
MOVE.L A0,-(SP) ;push the rts back on
_Pack6 autoPop ;_Pack6 w/autoPop
;never gets here
IF AddIUVer7Glue THEN ; <2>
;---------------
;
;FUNCTION CompareString(aStr: Str255;bStr: Str255;intlParam: Handle): INTEGER;
;
CompareString PROC EXPORT
IMPORT goPMagP
export IUCompPString ; obsolete old procedure name
IUCompPString
MOVE.W #iuSelMagPString,D2 ;the routine selector
JMP goPMagP
;
;FUNCTION IdenticalString(aStr: Str255;bStr: Str255;intlParam: Handle): INTEGER;
;
IdenticalString PROC EXPORT
EXPORT goPMagP
export IUEqualPString ; obsolete old procedure name
IUEqualPString
MOVE.W #iuSelMagIDPString,D2 ;the routine selector
goPMagP ;first readjust the stack so that it follows the MagPString/
;MagIdPString string passing convention instead of Pascal's
; at this point the stack is set up as follows:
; result ds.w 1 ; space for result
; aStr ds.l 1 ; Str255 pointer
; bStr ds.l 1 ; Str255 pointer
; itl2Handle ds.l 1 ; Handle
; return ds.l 1 ; (return address)
move.l 8(sp),a1 ; ptr to bStr
move.l 12(sp),a0 ; ptr to aStr
moveq #0,d0 ; for wordizing
move.b (a1)+,d0 ; get bLen & set bPtr
swap d0 ; bLen in high word
move.b (a0)+,d0 ; get aLen & set aPtr
move.l a0,12(sp) ; put aPtr on stack
move.l a1,8(sp) ; put bPtr on stack
move.l (sp)+,a0 ; pop return addr
move.l (sp)+,a1 ; pop itl2Handle
move.l d0,-(sp) ; push aLen/bLen
move.l a1,-(sp) ; push itl2Handle
; now the stack is set up as follows, just right for
; MagPString/MagIdPString
; result ds.w 1 ; space for result
; aPtr ds.l 1 ; Ptr
; bPtr ds.l 1 ; Ptr
; aLen ds.w 1 ; Integer
; bLen ds.w 1 ; Integer
; itl2Handle ds.l 1 ; Handle
move.w d2,-(sp) ; push selector
move.l a0,-(sp) ; push return address
_Pack6 autoPop ;_Pack6 w/autoPop
;never gets here
;
;FUNCTION StringOrder(aStr: Str255;bStr: Str255;aScript: ScriptCode;
; bScript: ScriptCode;aLang: LangCode;bLang: LangCode): INTEGER;
;
StringOrder PROC EXPORT
export IUStringOrder ; obsolete old procedure name
IUStringOrder
;first readjust the stack so that it follows the IUTextOrder
;string passing convention instead of Pascal's
; at this point the stack is set up as follows:
; result ds.w 1 ; space for result
; aStr ds.l 1 ; Str255 pointer
; bStr ds.l 1 ; Str255 pointer
; aScript ds.w 1 ; Integer
; bScript ds.w 1 ; Integer
; aLang ds.w 1 ; Integer
; bLang ds.w 1 ; Integer
; return ds.l 1 ; (return address)
move.l 12(sp),a1 ; ptr to bStr
move.l 16(sp),a0 ; ptr to aStr
moveq #0,d0 ; for wordizing
move.b (a1)+,d0 ; get bLen & set bPtr
swap d0 ; bLen in high word
move.b (a0)+,d0 ; get aLen & set aPtr
move.l a0,16(sp) ; put aPtr on stack
move.l a1,12(sp) ; put bPtr on stack
move.l (sp)+,a0 ; pop return addr
move.l (sp)+,d1 ; pop aLang/bLang
move.l (sp)+,d2 ; pop aScript/bScript
move.l d0,-(sp) ; push aLen/bLen
move.l d2,-(sp) ; push aScript/bScript
move.l d1,-(sp) ; push aLang/bLang
; now the stack is set up as follows, just right for IUTextOrder
; result ds.w 1 ; space for result
; aPtr ds.l 1 ; Ptr
; bPtr ds.l 1 ; Ptr
; aLen ds.w 1 ; Integer
; bLen ds.w 1 ; Integer
; aScript ds.w 1 ; Integer
; bScript ds.w 1 ; Integer
; aLang ds.w 1 ; Integer
; bLang ds.w 1 ; Integer
move.w #iuSelTextOrder,-(sp) ; push selector
move.l a0,-(sp) ; push return address
_Pack6 autoPop ;_Pack6 w/autoPop
;never gets here
;---------------
ENDIF
;
; PROCEDURE StringToNum(theString: Str255; VAR theNum: LongInt);
;
; convert a string into a number using Jerome's routine
;
StringToNum PROC EXPORT
IMPORT Exit8
MOVE.L 8(SP),A0
PackCall #1,_Pack7 ;LDec2Bin
MOVE.L 4(SP),A0
MOVE.L D0,(A0)
JMP Exit8
;
; PROCEDURE NumToString(theNum: LongInt; VAR theString: Str255);
;
; convert a number to a string using anonymous routine
;
NumToString PROC EXPORT
EXPORT Exit8
MOVE.L 4(SP),A0
MOVE.L 8(SP),D0
PackCall #0,_Pack7 ;LBin2Dec
Exit8 MOVE.L (SP)+,A0
ADDQ #8,SP
JMP (A0)
END