mirror of
https://github.com/elliotnunn/supermario.git
synced 2024-08-28 17:29:32 +00:00
508 lines
13 KiB
Plaintext
508 lines
13 KiB
Plaintext
;
|
||
; File: ObjMacros.a
|
||
;
|
||
; Contains: xxx put contents here xxx
|
||
;
|
||
; Written by: xxx put writers here xxx
|
||
;
|
||
; Copyright: © 1991 by Apple Computer, Inc., all rights reserved.
|
||
;
|
||
; Change History (most recent first):
|
||
;
|
||
; <7> 1/30/91 gbm sab, #38: Change the ‘already including this file’ variable to
|
||
; all uppercase (for security reasons)
|
||
;
|
||
; To Do:
|
||
;
|
||
|
||
; Version: 3.04
|
||
; Created: Friday, October 20, 1989 at 9:32:41 PM
|
||
;
|
||
; File: ObjMacros.a
|
||
;
|
||
; Assembler Interface to the Macintosh Libraries
|
||
; Copyright Apple Computer, Inc. 1986-1988
|
||
; All Rights Reserved.
|
||
;
|
||
;--------------------------------------------------------------------
|
||
; This file contains:
|
||
; Macros to support Object Assembler
|
||
; The InitObjects macro
|
||
; A template for TObject, the suggested root class for all objects
|
||
;
|
||
; The usable Macros in this file are documented in both the Assembler
|
||
; and MacApp manuals. Those macros are:
|
||
;
|
||
; ObjectDef
|
||
; ObjectIntf
|
||
; ObjectWith
|
||
; EndObjectWith
|
||
; ProcMethOf
|
||
; FuncMethOf
|
||
; EndMethod
|
||
; MethCall
|
||
; Inherited
|
||
; MoveSelf
|
||
; NewObject
|
||
; InitObjects
|
||
;
|
||
;
|
||
; Current limitations:
|
||
; 250 classes
|
||
; unlimited methods
|
||
;
|
||
; Object assembler programmers who do not use a Pascal main program
|
||
; MUST call the InitObjects macro at the beginning of their program.
|
||
;--------------------------------------------------------------------
|
||
;
|
||
; Modification history:
|
||
; *** MPW 2.0 ***
|
||
;--------------------------------------------------------------------
|
||
|
||
IF &TYPE('__INCLUDINGOBJMACROS__') = 'UNDEFINED' THEN
|
||
__INCLUDINGOBJMACROS__ SET 1
|
||
|
||
|
||
IMPORT %_METHOD
|
||
IMPORT %_OBNEW
|
||
IF &TYPE('ObjOptFlag') = 'UNDEFINED' THEN
|
||
ObjOptFlag: EQU 0
|
||
ENDIF
|
||
IF &TYPE('DebugFlag') = 'UNDEFINED' THEN
|
||
DebugFlag: EQU 1
|
||
ENDIF
|
||
|
||
|
||
MACRO
|
||
REFSELECTOR &ProcName,&ItsObjIndex,&OpCode
|
||
|
||
GBLA &ObjSupers[250],&MethLists[250], &MethTable
|
||
GBLC &ObjNames[250]
|
||
|
||
LCLA &start,&found,&objIndex,&LexInt
|
||
|
||
&found: SETA 0
|
||
IF &FINDSYM(&MethTable,&ProcName) THEN
|
||
&start: SETA 1
|
||
GOTO .EndLoop
|
||
WHILE &SYSTOKEN <> 30 DO
|
||
&LexInt: SETA &S2I(&SYSTOKSTR)
|
||
&objIndex: SETA &ItsObjIndex
|
||
WHILE (&objIndex <> 0) DO
|
||
IF &LexInt = &objIndex THEN
|
||
&OpCode &ObjNames[&objIndex]$&ProcName
|
||
&objIndex: SETA 0
|
||
&found: SETA 1
|
||
ELSE
|
||
&objIndex: SETA &ObjSupers[&objIndex]
|
||
ENDIF
|
||
ENDWHILE
|
||
.EndLoop
|
||
&start: SETA &LEX(&SYSVALUE, &start)
|
||
WHILE (&SYSTOKEN <> 1) AND (&SYSTOKEN <> 30) DO
|
||
&start: SETA &LEX(&SYSVALUE, &start)
|
||
ENDWHILE
|
||
ENDWHILE
|
||
ENDIF
|
||
|
||
IF &found = 0 THEN
|
||
AERROR &Concat('Error trying to reference method: ',&ProcName)
|
||
ENDIF
|
||
|
||
ENDMACRO
|
||
|
||
MACRO
|
||
SELECTORPROC &ProcName
|
||
LCLC &SaveSeg
|
||
&SaveSeg: SETC &SYSSEG
|
||
SEG '%_SelProcs'
|
||
&ProcName: PROC EXPORT
|
||
JSR %_METHOD
|
||
ENDPROC
|
||
SEG '&SaveSeg'
|
||
ENDMACRO
|
||
|
||
|
||
|
||
MACRO
|
||
ObjectTemplate &TypeName,&Heritage=NIL,&IntfOnly:INT=0
|
||
|
||
GBLA &ObjSupers[250],&MethLists[250]
|
||
GBLC &ObjNames[250]
|
||
GBLA &lastObjIndex, &currMethIndex, &MethTable
|
||
|
||
GBLA &NumFields,&NumMethods
|
||
GBLC &FieldList[250],&MethodList[250]
|
||
|
||
LCLA &methNum, &fieldNum, &objIndex
|
||
LCLC &SaveSeg, &RootIndex
|
||
LCLA &SuperIndex, &NumChars, &Temp
|
||
LCLA &methIndex, &foundIndex, &MethFlag, &SymReturn
|
||
|
||
LCLC &TempArray[1],&CurrField[2],&CurrMethod[3]
|
||
|
||
IF &MethTable = 0 THEN
|
||
&MethTable: SETA &NEWSYMTBL
|
||
ENDIF
|
||
|
||
&lastObjIndex: SETA &lastObjIndex+1
|
||
&ObjNames[&lastObjIndex]: SETC &TypeName
|
||
&MethLists[&lastObjIndex]: SETA &currMethIndex+1
|
||
IF (&Heritage = 'NIL') THEN
|
||
&ObjSupers[&lastObjIndex]: SETA 0
|
||
ELSE
|
||
&SuperIndex: SETA 1
|
||
&ObjNames[&lastObjIndex+1]: SETC &Heritage
|
||
WHILE (&ObjNames[&SuperIndex] <> &Heritage) DO
|
||
&SuperIndex: SETA &SuperIndex+1
|
||
ENDWHILE
|
||
IF (&SuperIndex > &lastObjIndex) THEN
|
||
AERROR &Concat('Non-existent Ancestor Object Type: ',&Heritage)
|
||
ELSE
|
||
&ObjSupers[&lastObjIndex]: SETA &SuperIndex
|
||
ENDIF
|
||
ENDIF
|
||
|
||
IF &NumFields >= 0 THEN
|
||
&fieldNum: SETA 1
|
||
%&TypeName: RECORD &Heritage.Offset
|
||
WHILE &fieldNum <= &NumFields DO
|
||
&NumChars: SETA &LEN(&FieldList[&fieldNum])-2
|
||
&Temp: SETA &LIST(&FieldList[&fieldNum,2:&NumChars], '&CurrField')
|
||
IF &Eval(&CurrField[2]) >= 2 THEN
|
||
ALIGN 2
|
||
ENDIF
|
||
&CurrField[1]: DS.B &CurrField[2]
|
||
&fieldNum: SETA &fieldNum+1
|
||
ENDWHILE
|
||
ALIGN 2
|
||
last: EQU *
|
||
ENDR
|
||
&TypeName.Offset: EQU %&TypeName..last
|
||
ENDIF
|
||
|
||
IF &NumMethods > 0 THEN
|
||
&methNum: SETA 1
|
||
WHILE &methNum <= &NumMethods DO
|
||
&NumChars: SETA &LEN(&MethodList[&methNum])-2
|
||
&CurrMethod[2]: SETC ''
|
||
&CurrMethod[3]: SETC ''
|
||
&Temp: SETA &LIST(&MethodList[&methNum,2:&NumChars], '&CurrMethod')
|
||
IF (&CurrMethod[2] = '') OR (&UC(&CurrMethod[2]) = 'IMPL') THEN
|
||
IF (&UC(&CurrMethod[2]) = 'IMPL') THEN
|
||
IF &IntfOnly THEN
|
||
IMPORT &TypeName.$&CurrMethod[1]
|
||
ELSE
|
||
AERROR &Concat('IMPL only allowed in ObjectIntf Macro. Error at ', \
|
||
&CurrMethod[1],' in ',&TypeName)
|
||
ENDIF
|
||
ELSEIF &IntfOnly THEN
|
||
IMPORT &TypeName.$&CurrMethod[1]
|
||
ELSE
|
||
SELECTORPROC &TypeName.$&CurrMethod[1]
|
||
ENDIF
|
||
&currMethIndex: SETA &currMethIndex+1
|
||
&SymReturn: SETA &ENTERSYM(&MethTable,&I2S(&currMethIndex),&CurrMethod[1],0)
|
||
|
||
* First do findsym to see if other unrelated root classes
|
||
IF &FINDSYM(&MethTable,&CurrMethod[1]) THEN
|
||
&RootIndex: SETC &Concat(&SYSVALUE,' ',&I2S(&lastObjIndex))
|
||
&MethFlag: SETA &SYSFLAGS+1
|
||
ELSE
|
||
&RootIndex: SETC &I2S(&lastObjIndex)
|
||
&MethFlag: SETA 1
|
||
ENDIF
|
||
&SymReturn: SETA &ENTERSYM(&MethTable,&CurrMethod[1],&RootIndex,&MethFlag)
|
||
ELSEIF (&UC(&CurrMethod[2]) <> 'OVERRIDE') THEN
|
||
AERROR &Concat(&CurrMethod[2],' illegal after ',&CurrMethod[1], \
|
||
' in ',&TypeName)
|
||
ENDIF
|
||
IF NOT &IntfOnly THEN
|
||
EXPORT &TypeName._&CurrMethod[1]
|
||
ELSEIF (&UC(&CurrMethod[2]) = 'IMPL') OR (&UC(&CurrMethod[3]) = 'IMPL') THEN
|
||
EXPORT &TypeName._&CurrMethod[1]
|
||
ELSE
|
||
IMPORT &TypeName._&CurrMethod[1]
|
||
ENDIF
|
||
&methNum: SETA &methNum+1
|
||
ENDWHILE
|
||
|
||
IF NOT &IntfOnly THEN
|
||
&SaveSeg: SETC &SYSSEG
|
||
SEG '%_MethTables'
|
||
CODEREFS FORCEJT
|
||
_&TypeName: PROC EXPORT
|
||
DC.W _&TypeName
|
||
IF &Heritage = 'NIL' THEN
|
||
DC.W 0
|
||
ELSE
|
||
DC.W _&Heritage
|
||
ENDIF
|
||
DC.W &TypeName.Offset
|
||
DC.W &methNum-1
|
||
&methNum: SETA 1
|
||
WHILE &methNum <= &NumMethods DO
|
||
&NumChars: SETA &LEN(&MethodList[&methNum])-2
|
||
&CurrMethod[2]: SETC ''
|
||
&CurrMethod[3]: SETC ''
|
||
&Temp: SETA &LIST(&MethodList[&methNum,2:&NumChars], '&CurrMethod')
|
||
IF (&CurrMethod[2] = '') THEN
|
||
DC.W &TypeName.$&CurrMethod[1]
|
||
ELSEIF (&UC(&CurrMethod[2]) = 'OVERRIDE') THEN
|
||
IF &superIndex = 0 THEN
|
||
AERROR &Concat('Override of Non-existent method: ',&CurrMethod[1])
|
||
ELSE
|
||
REFSELECTOR &CurrMethod[1],&superIndex,DC.W
|
||
ENDIF
|
||
ENDIF
|
||
IMPORT &TypeName._&CurrMethod[1]
|
||
DC.W &TypeName._&CurrMethod[1]
|
||
&methNum: SETA &methNum+1
|
||
ENDWHILE
|
||
ENDPROC
|
||
SEG '&SaveSeg'
|
||
CODEREFS NOFORCEJT
|
||
ELSE
|
||
IMPORT _&TypeName
|
||
ENDIF
|
||
ENDIF
|
||
&MethLists[&lastObjIndex+1]: SETA &currMethIndex+1
|
||
ENDMACRO
|
||
|
||
|
||
MACRO
|
||
ObjectDef &TypeName,&Heritage=NIL
|
||
|
||
GBLA &NumFields,&NumMethods
|
||
GBLC &FieldList[250],&MethodList[250]
|
||
|
||
LCLA &index1, &index2
|
||
|
||
&index1: SETA 3
|
||
&index2: SETA 1
|
||
WHILE &NBR(&SYSLIST[&index1]) <> 0 DO
|
||
&FieldList[&index2]: SETC &SYSLIST[&index1]
|
||
&index1: SETA &index1+1
|
||
&index2: SETA &index2+1
|
||
ENDWHILE
|
||
&NumFields: SETA &index2-1
|
||
|
||
&index2: SETA 1
|
||
IF &SYSLIST[&index1] = 'METHODS' THEN
|
||
&index1: SETA &index1+1
|
||
WHILE &NBR(&SYSLIST[&index1]) <> 0 DO
|
||
&MethodList[&index2]: SETC &SYSLIST[&index1]
|
||
&index1: SETA &index1+1
|
||
&index2: SETA &index2+1
|
||
ENDWHILE
|
||
ENDIF
|
||
&NumMethods: SETA &index2-1
|
||
|
||
ObjectTemplate &TypeName,&Heritage,0
|
||
ENDMACRO
|
||
|
||
|
||
MACRO
|
||
ObjectIntf &TypeName,&Heritage=NIL
|
||
|
||
GBLA &NumFields,&NumMethods
|
||
GBLC &FieldList[250],&MethodList[250]
|
||
|
||
LCLA &index1, &index2
|
||
|
||
&index1: SETA 3
|
||
&index2: SETA 1
|
||
WHILE &NBR(&SYSLIST[&index1]) <> 0 DO
|
||
&FieldList[&index2]: SETC &SYSLIST[&index1]
|
||
&index1: SETA &index1+1
|
||
&index2: SETA &index2+1
|
||
ENDWHILE
|
||
&NumFields: SETA &index2-1
|
||
|
||
&index2: SETA 1
|
||
IF &SYSLIST[&index1] = 'METHODS' THEN
|
||
&index1: SETA &index1+1
|
||
WHILE &NBR(&SYSLIST[&index1]) <> 0 DO
|
||
&MethodList[&index2]: SETC &SYSLIST[&index1]
|
||
&index1: SETA &index1+1
|
||
&index2: SETA &index2+1
|
||
ENDWHILE
|
||
ENDIF
|
||
&NumMethods: SETA &index2-1
|
||
|
||
ObjectTemplate &TypeName,&Heritage,1
|
||
ENDMACRO
|
||
|
||
|
||
|
||
MACRO
|
||
OBJECTWITH &TypeName
|
||
GBLA &WithLevel[8]
|
||
GBLA &WithIndex
|
||
GBLA &ObjSupers[*]
|
||
GBLC &ObjNames[*]
|
||
GBLA &lastObjIndex
|
||
|
||
GBLC &currObjName,&currSuperName
|
||
GBLA &currObjIndex
|
||
|
||
LCLA &SuperIndex
|
||
&currObjName: SETC &TypeName
|
||
&SuperIndex: SETA 1
|
||
&ObjNames[&lastObjIndex+1]: SETC &TypeName
|
||
WHILE &ObjNames[&SuperIndex] <> &TypeName DO
|
||
&SuperIndex: SETA &SuperIndex+1
|
||
ENDWHILE
|
||
&currObjIndex: SETA &SuperIndex
|
||
IF &SuperIndex > &lastObjIndex THEN
|
||
AERROR &Concat('Object Type name does not exist: ',&TypeName)
|
||
ELSE
|
||
IF &ObjSupers[&SuperIndex] = 0 THEN
|
||
&currSuperName: SETC 'NIL'
|
||
ELSE
|
||
&currSuperName: SETC &ObjNames[&ObjSupers[&SuperIndex]]
|
||
ENDIF
|
||
WITH %&TypeName
|
||
&WithIndex: SETA &WithIndex+1
|
||
WHILE &ObjSupers[&SuperIndex] <> 0 DO
|
||
WITH %&ObjNames[&ObjSupers[&SuperIndex]]
|
||
&WithLevel[&WithIndex]: SETA &WithLevel[&WithIndex]+1
|
||
&SuperIndex: SETA &ObjSupers[&SuperIndex]
|
||
ENDWHILE
|
||
ENDIF
|
||
ENDMACRO
|
||
|
||
MACRO
|
||
METHOD &MethName,&TypeName,&FuncORProc=PROC
|
||
&TypeName._&MethName: &FuncORProc EXPORT
|
||
OBJECTWITH &TypeName
|
||
ENDMACRO
|
||
|
||
MACRO
|
||
&MethName: ProcMethOf &TypeName
|
||
METHOD &MethName,&TypeName,PROC
|
||
ENDMACRO
|
||
|
||
MACRO
|
||
&MethName: FuncMethOf &TypeName
|
||
METHOD &MethName,&TypeName,FUNC
|
||
ENDMACRO
|
||
|
||
MACRO
|
||
ObjectEndWith
|
||
ENDWITH
|
||
GBLA &WithLevel[*]
|
||
GBLA &WithIndex
|
||
IF &WithIndex > 0 THEN
|
||
WHILE &WithLevel[&WithIndex] > 0 DO
|
||
ENDWITH
|
||
&WithLevel[&WithIndex]: SETA &WithLevel[&WithIndex]-1
|
||
ENDWHILE
|
||
&WithIndex: SETA &WithIndex-1
|
||
ENDIF
|
||
ENDMACRO
|
||
|
||
|
||
MACRO
|
||
ENDMETHOD
|
||
ObjectEndWith
|
||
ENDPROC
|
||
ENDMACRO
|
||
|
||
|
||
MACRO
|
||
METHCALL &MethName,&ObjTypeName
|
||
GBLC &ObjNames[*]
|
||
GBLA &currObjIndex, &lastObjIndex
|
||
|
||
LCLA &objIndex
|
||
IF &ObjTypeName = '' THEN
|
||
&objIndex: SETA &currObjIndex
|
||
ELSE
|
||
&objIndex: SETA 1
|
||
&ObjNames[&lastObjIndex+1]: SETC &ObjTypeName
|
||
WHILE &ObjNames[&objIndex] <> &ObjTypeName DO
|
||
&objIndex: SETA &objIndex+1
|
||
ENDWHILE
|
||
ENDIF
|
||
IF &objIndex > &lastObjIndex THEN
|
||
AERROR &Concat('Unknown Object type Name: ',&ObjTypeName)
|
||
ELSEIF ObjOptFlag THEN
|
||
JSR &ObjNames[&objIndex]$&MethName
|
||
ELSE
|
||
REFSELECTOR &MethName,&objIndex,JSR
|
||
ENDIF
|
||
ENDMACRO
|
||
|
||
MACRO
|
||
INHERITED &MethName
|
||
GBLC &ObjNames[*]
|
||
GBLA &ObjSupers[*]
|
||
GBLA &currObjIndex
|
||
|
||
LCLA &objIndex
|
||
|
||
&objIndex: SETA &ObjSupers[&currObjIndex]
|
||
WHILE (&TYPE(&Concat(&ObjNames[&objIndex],'_',&MethName)) = 'UNDEFINED') AND (&objIndex <> 0) DO
|
||
&objIndex: SETA &ObjSupers[&objIndex]
|
||
ENDWHILE
|
||
IF &objIndex = 0 THEN
|
||
AERROR &Concat('Inherited error; Method not defined in ancestor: ',&MethName)
|
||
ELSE
|
||
IMPORT &ObjNames[&objIndex]_&MethName
|
||
JSR &ObjNames[&objIndex]_&MethName
|
||
ENDIF
|
||
ENDMACRO
|
||
|
||
|
||
MACRO
|
||
MoveSelf &Dest
|
||
MOVE.L 8(A6),&Dest
|
||
ENDMACRO
|
||
|
||
|
||
MACRO
|
||
NewObject &Loc,&TypeName,&Size
|
||
PEA &Loc
|
||
PEA _&TypeName+2
|
||
IF &Size = '' THEN
|
||
MOVE.W #&TypeName.Offset,-(SP)
|
||
ELSE
|
||
MOVE.W #&Size,-(SP)
|
||
ENDIF
|
||
JSR %_OBNEW
|
||
ENDMACRO
|
||
* The InitObjects macro must be called if the main program is not in Pascal
|
||
|
||
IMPORT %_PGM1
|
||
|
||
MACRO
|
||
InitObjects
|
||
|
||
JSR %_PGM1
|
||
ENDMACRO
|
||
|
||
|
||
NILOffset EQU 2
|
||
|
||
IF DebugFlag THEN
|
||
|
||
ObjectIntf TObject,, \ Suggested root class for all objects
|
||
METHODS, \ no data fields
|
||
(ShallowClone), \ Object copying method; rarely overridden
|
||
(Clone), \ Can be overriden to clone fields
|
||
(ShallowFree), \ Frees object; rarely overridden
|
||
(Free), \ Can be overriden to free fields
|
||
(ClassName), \ Returns name of class
|
||
(Inspect) ; Print info to debug window
|
||
ELSE
|
||
ObjectIntf TObject,, \ Suggested root class for all objects
|
||
METHODS, \ no data fields
|
||
(ShallowClone), \ Object copying method; rarely overridden
|
||
(Clone), \ Can be overriden to clone fields
|
||
(ShallowFree), \ Frees object; rarely overridden
|
||
(Free) ; Can be overriden to free fields
|
||
|
||
ENDIF
|
||
|
||
ENDIF ; ...already included |