Simtel MSDOS 1992 September/Simtel20_Sept92.cdr/msdos/ddjmag/ddj8908.arc/THOMAS.LST

File List | 1989-07-06 | 33KB | 847 lines

SMALLTALK + C: THE POWER OF TWO
by Dave Thomas and Randolph Best

[LISTING ONE]

Object subclass: #Dos
  instanceVariableNames:
    'registers temp1 temp2 '
  classVariableNames: ''
  poolDictionaries: '' !

!Dos methods !

doDCSPrimitive: opcode
     "PRIVATE - Call the DCS Primitives using an interrupt"
     <primitive: 96>
getEnvironmentValue: anEnvironmentString
     "Private- This is a method for getting the
     value of an environment variable(string). Answers
     the value if anEnvironmentString is valid or nil
     if not found.
     Here the instance variables are
     used as follows:
        temp1 = the name of the environment variable wanted
        temp2 = the value of the environment, if the
                      environment variable exists.      "
    temp1 := anEnvironmentString asAsciiZ.
    temp2 := String new: 128.
    (self doDcsPrimitive: -11)
        ifTrue:[ ^temp2 trimBlanks ]
        ifFalse:[ ^''].!

[LISTIN╟ TWO]

;*****************************************************************************
;ACCESS.USR - PRIMITIVE ENTRY MACRO - SMALLTALK/V
;Copyright (C) 1986 - Digitalk, Inc. - Reprinted by Permission
;*****************************************************************************
; It is essential that this macro appear at the beginning of
; the primitive in that it saves certain registers.  Some of
; the registers may or may not have to be restored depending on
; whether or not the primitive is successful, and some
; must be restored before exiting the primitive.

enterPrimitive     MACRO

; At the end of this macro the stack will appear as below:
;  SP--> BP--> - saved BP - must be restored on exit
;          +2  - saved BX - must be restored in case of failure
;          +4  - saved DI - must be restored in case of failure
;          +6  - saved SI - must be restored on exit
;          +8  - saved DS - must be restored on exit
;          +10 - IP
;          +12 - CS
;          +14 - FLAGS
; if there are any argument passed to the primitive they are found here
;          +16 - last argument to primitive
;          +18 - second last argument to primitive
;              - etc...
; high address -
; Note: some of the following macros use BP assuming the value has not
;       changed from what this macro sets it to.  If you use BP be sure
;       to restore it before using the macros that make use of BP.

                   PUSH   DS                     ;set up stack as shown above
                   PUSH   SI
                   PUSH   DI
                   PUSH   BX
                   PUSH   BP
                   MOV    BP,SP                  ;set BP to Top of Stack
                   ENDM

; This macro must be used when the primitive must be exited and the
; primitive was SUCCESSFUL.  The resulting pointer or small integer
; must be in BX before invoking this macro.  The macro will:
;   - mark the object (pointer) in BX so that the garbage collector
;     will not collect it as garbage
;   - certain registers are restored
;   - the return address and flags are popped into temporary registers
╗   ¡ thσ argument≤ arσ flusheΣ anΣ replaceΣ witΦ thσ resul⌠ iε BX
;   - the return address and flags are put back on the stack
;   - AX is set to zero (AH=0 indicates that the primitive was successful)
;   - and the IRET instruction is executed

exitWithSuccess    MACRO  numOfArgs

; On entry BX must contains the result to be pushed
; on the stack.è
                   markPtr BX,ES                 ;mark result object in BX
                   POP    BP                     ;restore BP
                   ADD    SP,4
                   POP    SI                     ;restore DS:SI pair
                   POP    DS
                   POP    CX                     ;pop the offset,segment and
                   POP    DX                     ;flags into temp registers
                   POP    AX
IF numOfArgs
                   ADD    SP,numOfArgs * 2 + 2   ;flush all args of primitive
ENDIF
                   PUSH   BX                     ;push result on stack
                   PUSH   AX                     ;push flags, segment and
                   PUSH   DX                     ;offset back onto stack
                   PUSH   CX
                   XOR    AX,AX                  ;AH to 0 (prim was successful)
                   IRET                          ;interrupt return
                   ENDM

; This macro must be used when the primitive must be exited and the
; primitive FAILED.  The macro will:
;   - restore all saved registers
;   - set AH to 1 indicating failure condition and AL to the number
;     of arguments passed to the primitive
;   - and the IRET instruction is executed

exitWithFailure    MACRO  numOfArgs

                   POP    BP                     ;restore all saved registers
                   POP    BX
                   POP    DI
                   POP    SI
                   POP    DS
                   MOV    AX,256 + numOfArgs     ;AH to 1 (prim failed)
                   IRET                          ;interrupt return
                   ENDM

; This macro will return the address of the object with object pointer
; in objectReg.  The address will be returned in the register pair
; segmentReg:offsetReg.  segmentReg must be a segment register.

getObjectAddress   MACRO  objectReg,offsetReg,segmentReg

; All the arguments must be different registers.
; BP must not have changed from the value it was
; set to in the enterPrimitive macro.

                   MOV    segmentReg,[BP+12]
                   ROR    objectReg,1
                   MOV    offsetReg,segmentReg:[objectReg]
                   ROL    objectReg,1
                   MOV    segmentReg,SS:[objectReg]
                   AND    offsetReg,MASK offsetMask
                   ENDMè
; This macro will mark the object whose object pointer is in objectReg
; so the garbage collector will not collect as garbage.  It is to be used
; whenever an object pointer is stored.  If the object in objectReg is
; a small integer, no marking occurs.

markPtr            MACRO  objectReg,segmentReg
                   LOCAL  done

; BP must not have changed from the value it was
; set to in the enterPrimitive macro.

                   ROR    objectReg,1
                   JNC    done
                   MOV    segmentReg,[BP+12]
                   OR     BYTE PTR segmentReg:[objectReg],MASK grayMask
done:              ROL    objectReg,1

                   ENDM

; This macro will get the class (pointer) of the object whose pointer
; is in objectReg.  If the object in objectReg is a small integer then
; the class pointer is set to ClassSmallInt.

getClass           MACRO  objectReg,classReg,segmentReg
                   LOCAL  done
;all the arguments must be different registers

                   MOV    classReg,ClassSmallInt
                   TEST   objectReg,1
                   JZ     done
                   MOV    classReg,SS
                   SHR    classReg,1
                   MOV    segmentReg,classReg
                   MOV    classReg,segmentReg:[objectReg]
done:
                   ENDM

; This macro will set the zero condition flag as to whether the object size
; is an even or odd number of bytes.  This test should be performed on
; byte-addressable objects.  A zero condition means that the object is an
; even number of bytes (actual size = object header - 2).  A non-zero
; condition means that the object is an odd number of bytes
; (actual size = object header - 3).

isSizeEven         MACRO  objectReg,workReg,segmentReg

; BP must not have changed from the value it was
; set to in the enterPrimitive macro.

                   MOV    workReg,objectReg
                   ROR    objectReg,1
                   MOV    segmentReg,[BP+12]
                   TEST   BYTE PTR segmentReg:[objectReg],MASK oddMask
                   MOV    objectReg,workRegè                   ENDM

;*****************************************************************************
; PRIMITIVE ENTRY POINT SAMPLE CODE FRAGMENTS
;*****************************************************************************

                DW      getCountryEnt
                DW      getEnvironEnt
        DW    exeApplicEnt
                DW      exeProgramEnt
        DW    setNoXlatEnt
        DW    setXlatEnt
        DW    atEndEnt
                DW      bufFlushEnt
        DW    bufWriteEnt
        DW    bufReadEnt
        DW    initOutputEnt
        DW    initInputEnt
jumpTable    DW    interruptEnt
        DW    inWordEnt
        DW    inByteEnt
        DW    outWordEnt
        DW    outByteEnt
        DW    peekEnt
        DW    pokeEnt
        DW    blockMoveEnt

                *
                *
                *

dcsPrims        proc    far

; This is code that will be executed everytime this primitive
; is invoked from "Smalltalk/V"

        enterPrimitive                  ;enter primitive macro

        mov     bx,[bp+16]              ;get function code from first instance
        test    bl,1                    ; variable of receiving object.  if it
        jnz     failure                 ; isn't a number then something's very
                                        ; rotten in the state of Denmark.

        cmp     bx,16                   ;the function code is already shifted
        jge     failure                 ; left by one (courtesy of smalltalk's
        cmp     bx,-26                  ; way of identifying integers), so do
        jle     failure                 ; some range checks and abort if the
                                        ; value is out of bounds.

        jmp     cs:[bx+jumpTable]       ;otherwise, jump to the code associated
                                        ; with this function number.
         *
         *
         *
è        mov     cs:stackOfs,sp          ;save the current Smalltalk stack, and
        mov     cs:stackSeg,ss          ; replace it with a local stack in low
        mov     ax,cs                   ; (protected memory).
    cli
    mov    ss,ax
    lea    sp,cs:_stack
    sti

        mov     ah,2fh                  ;save the DOS DTA pointer, just in case
        int     21h                     ; it gets clobbered by the application.
    mov    cs:dtaOfs,bx
    mov    cs:dtaSeg,es

        call    exec                    ;load and execute the program
        mov     bx,truePtr              ; the errorlevel
        jnc     exec01                  ; code is returned in "retCode". If the
        mov     bx,falsePtr             ; carry was set, then an error occurred
exec01: mov     retVal,bx               ; and we answer "false", otherwise we
                                        ; answer "true".
        mov     ah,1ah                  ;restore the DOS DTA pointer.
    lds    dx,cs:dtaPtr
    int    21h

        cli                             ;and, restore the Smalltalk stack with
        mov     ss,cs:stackseg          ; the saved pointer.
    mov    sp,cs:stackofs
    sti

        mov     ax,retCode              ;convert the errorlevel to a Smalltalk
        shl     ax,1                    ; integer format, and return it in the
        les     bx,receiverPtr          ; fifth instance variable of receiver
        mov     es:[bx+12],ax           ; object.

        mov     bx,retVal               ;the Smalltalk convention is to put the
        jmp     success1                ; answer for this obj in bx, and call
                                        ; the "leavePrimitive" macro.  a jump
                                        ; to success will do this quite nicely
                                        ; thank yew!

[LISTIN╟ THREE]

;queue an interpreter interrupt (in protected mode)
;  AL=interrupt number to queue
interruptVM MACRO
            CALL DWORD PTR SS:[queueVMinterrupt]
            ENDM
;queue an interpreter interrupt (in real mode)
ISVinterruptVM MACRO
            MOV ES,CS:[realParmSeg]
            CALL DWORD PTR ES:[ISVqueueVMinterrupt]
            ENDM
The code to call the socket primitive in Smalltalk is:
socketPrimitiveOpcode: opcode withArguments: argumentArray
    "PRIVATE: Call the socket primitive."
    <primitive: socketPrimitive>
    ^self error: 'Network Primitive failed - is sockprim.bin loaded?'


[LISTIN╟ FOUR]

;*****************************************************************************
;* FIXDPTRS.USR
;*****************************************************************************

;fixed segments

plusSmallSeg            = 6         ;segment of small positive integers
nilSegment              = 106H      ;segment of nil object
minusSmallSeg           = 116H      ;segment of small negative integers
booleanSeg              = 10EH      ;segment for true and false
characterSeg            = 11EH      ;segment for all character objects
fixedPtrSeg             = 126H      ;segment for all fixed ptr objects

;fixed offsets

nilOffset               = 106H      ;offset of nil object
trueOffset              = 0fff3H    ;offset of true object
falseOffset             = 0fff1H    ;offset of false object
firstCharOffset         = 2         ;offset of ascii char 0

;all of the following objects are in the segment fixedPtrSeg
;what is given below are their offsets
                                    ;array of classes in system
classArrayOffset    equ nilOffset+size objectHeader
Smalltalk           equ classArrayOffset + size assoc
ErrorCode           equ Smalltalk + size assoc

;*****************************************************************************
; OBJECTS.USR
;*****************************************************************************

;Object header structure

objectHeader STRUC
ClassPtrHash    DW ?        ;see below for values for fixed classesèObjectPtrHash   DW ?        ;usually contains object hash
GCreserved      DW ?
NumberFixed     DW ?        ;number of named instance variables
ObjectSize      DB 3 DUP(?) ;stored as low,middle,high order
                            ;  size is stored as # of instance variables
ObjectFlags     DB ?        ;defined below
objectHeader    ENDS

;object flags (contained in objectFlag byte of objectHeader)
PointerBit      EQU 10H     ;Object contains pointers
IndexedBit      EQU 8       ;Object has indexed instance variables
;other bits in byte are reserved

;Array Object
arrayObj STRUC
            DB size objectHeader DUP (?)
arrayObj    ENDS

;Character Object
charObj STRUC
            DB size objectHeader DUP (?)
asciiValue  DD ?            ;ascii value
charObj     ENDS
;Note that this is 16 bytes in size

; Association Object
assoc STRUC
            DB size objectHeader DUP (?)
assocKey    DD  ?
assocValue  DD  ?
assoc       ENDS

; Point object
pointObj STRUC
            DB size objectHeader DUP (?)
pointX      DD  ?
pointY      DD  ?
pointObj    ENDS

; Hash values for classes
SmallIntegerHash equ    0
emptySlotHash   equ     SmallIntegerHash + 8
StringHash      equ     emptySlotHash + 8
MessageHash     equ     StringHash + 8
SymbolClassHash equ     MessageHash + 8
LargePosIntHash equ     SymbolClassHash + 8
HomeContextHash equ     LargePosIntHash + 8
LargeNegIntHash equ     HomeContextHash + 8
ContextHash     equ     LargeNegIntHash + 8
PointHash       equ     ContextHash + 8
ArrayHash       equ     PointHash + 8
LinkHash        equ     ArrayHash + 8

; This is a useful struc for accessing arguments in primitives
; For example, to load the receiver into DS:SIè;           LDS SI,[BP+receiverPtr]

;stack after enterPrimitive macro
primitiveFrame STRUC
savedBP         DW  ?
returnAddr      DD  ?
receiverPtr     DD  ?
arg1Ptr         DD  ?
arg2Ptr         DD  ?
arg3Ptr         DD  ?
primitiveFrame  ENDS

;This struc defines the beginning of a user primitive load module
primLoadModule STRUC
installEntry        DW ?       ; 0 entry point for installation routine
reserved1           DW 0       ; 2
                    DW 0       ; 4
realCodeSeg         DW ?       ; 6 after loading, will contain real mode addr
primTableOffset     DW ?       ; 8 offset of table of primitive subroutines
realParmSeg         DW ?       ; A after loading, will contain real mode addr
                               ;   of virtual machine communication area.
reserved2           DW 0       ; C
                    DW 0       ; E
primLoadModule ENDS

;*****************************************************************************
;* ACCESS.USR -PRIMITIVE ENTRY MACRO - SMALLTALK/V286
;* Copyright (C) 1988 - Digitalk, Inc. - Reprinted by Permission
;*****************************************************************************

; It is essential that this macro appear at the beginning of
; the primitive in that it saves certain registers.  Some of
; the registers may or may not have to be restored depending on
; whether or not the primitive is successful, and some
; must be restored before exiting the primitive.

enterPrimitive MACRO

; At the end of this macro the stack will appear as below:
;
;  SP--> BP-->  - saved BP
;           +2  - return addr (offset)
;           +4  - return addr (segment)
; If there are any argument passed to the primitive they are found here.
; All arguments and the receiver are passed as 32 bit pointers
;           +6  - receiver of primitive  (offset)
;           +8  - receiver of primitive  (segment)
;           +10 - first argument to primitive  (offset)
;           +12 - first argument to primitive  (segment)
;               -           :
; high address  -           :
;
; Note: some of the following macros use BP assuming the value has not
;       changed from what this macro sets it to.  If you use BP be sure
;       to restore it before using the macros that make use of BP.è
            PUSH    BP              ;save old BP
            MOV     BP,SP           ;set BP to Top of Stack
            ENDM

; This macro must be used when the primitive must be exited and the
; primitive was SUCCESSFUL.  The resulting pointer or small integer
; must be in DX,AX (DX=segment, AX=offset) before invoking this macro.

exitWithSuccess MACRO

; On entry DX,AX must contains the result to be pushed
; on the stack.
            MOV     SP,BP
            POP     BP              ;restore BP
            RETF                    ;far return
            ENDM

; This macro must be used when the primitive must be exited and the
; primitive FAILED.

exitWithFailure MACRO

            XOR     AX,AX           ;AX=DX=0, for failure return
            XOR     DX,DX
            MOV     SP,BP
            POP     BP              ;restore BP
            RETF                    ;far return
            ENDM

;Object testing macros
;
;in the following testing macros,
;the result is returned in the zero flag as follows:  z=no,  nz=yes

;Object has pointers?? jz=no, jnz=yes
isPointerObject MACRO objSeg,objOff
            TEST objSeg:[objOff+objectFlags],PointerBit
            ENDM

;Object is indexable?? jz=no, jnz=yes
isIndexedObject MACRO objSeg,objOff
            TEST objSeg:[objOff+objectFlags],IndexedBit
            ENDM

;Object is contained in single segment?? jz=no, jnz=yes
isSmallObject MACRO objSeg,objOff
            OR  objOff,objOff
            ENDM

;**** size extraction macros ****

;Object size is expressable in elements or bytes.
;   elements is the number of smalltalk objects it contains
;   bytes is the number of bytes it occupies (including header)è;       note that objects always occupy an even number of bytes
;For example:
;   #( 1 2 3 ) is an array with three element≤ and it occupies 24 bytes
;   'hello'    is a string with 5 element≤ and it occupies 18 bytes

;extract the size in elements
getElementSize MACRO objSeg,objOff,resultLowWord,resultHighByte
            MOV resultHighByte,byte ptr objSeg:[objOff+objectSize+2]
            MOV resultLowWord,word ptr objSeg:[objOff+objectSize]
            ENDM

;compute the size in bytes
getBigByteSize MACRO objSeg,objOff,resultLowWord,resultHighByte
            LOCAL addHeader
            getElementSize objSeg,objOff,resultLowWord,resultHighByte
            isPointerObject objSeg,objOff
            JZ  addHeader
            ADD resultLowWord,resultLowWord
            ADC resultHighByte,resultHighByte
            ADD resultLowWord,resultLowWord
            ADC resultHighByte,resultHighByte
addHeader:  ADD resultLowWord,size objectHeader+1
            ADC resultHighByte,0
            AND resultLowWord,0FFFEH
            ENDM

;user calls to interpreter routines

;routine vector offsets
ISVqueueVMinterrupt equ 0FFF0H - 4
queueVMInterrupt    equ ISVqueueVMinterrupt-4
oldToNewStore       equ queueVMinterrupt-4      ;used in oldToNewUpdate macro

;queue an interpreter interrupt (in protected mode)
;  AL=interrupt number to queue
interruptVM MACRO
            CALL DWORD PTR SS:[queueVMinterrupt]
            ENDM

;queue an interpreter interrupt (in real mode)
ISVinterruptVM MACRO
            MOV ES,CS:[realParmSeg]
            CALL DWORD PTR ES:[ISVqueueVMinterrupt]
            ENDM

;miscellaneous but usefull macros

;is object a small positive integer --  je=yes, jne=no
;(only segment needs to be tested)
isSmallPosInt MACRO segmentExpression
        CMP segmentExpression,plusSmallSeg
        ENDM

;is object a small negative integer --  je=yes, jne=no
;(only segment needs to be tested)èisSmallNegInt MACRO segmentExpression
        CMP segmentExpression,minusSmallSeg
        ENDM

;is object a character --   je=yes, jne=no
;(only segment needs to be tested)
isCharacter MACRO segmentExpression
        CMP segmentExpression,characterSeg
        ENDM

;is object static, i.e. constant, no stores allowed -- ja=no, jbe=yes
;(only segment needs to be tested)
isStaticObject MACRO segmentExpression
        CMP segmentExpression,characterSeg
        ENDM

;****** This macro must be called after EVERY pointer store *******
;****** Failure to do so will invalidate the garbage collector ****
;****** leading to catastrophic and unpredicable results **********

;This macro detects old space to new space pointer stores,
;and updates the GC data base accordingly.
;
;macro arguments are as follows:
;   segReg    = seg reg of object stored into
;   offReg    = offset reg of object stored into
;   valueSeg  = segment of pointer that was stored
;   workReg   = a work register
;
;example of use:  store ptr BX:AX into object ES:DI at slot 'contents'
;           MOV word ptr es:[di+contents],AX    ;store offset
;           MOV word ptr es:[di+contents+2],BX  ;store segment
;           OldToNewUpdate es,di,bx,ax
OldToNewUpdate macro segReg,offReg,valueSeg,workReg
            LOCAL done
            MOV workReg,segReg
            CMP workReg,92EH
            JAE done
            CMP valueSeg,92EH
            JB  done
            PUSH segReg
            PUSH offReg
            CALL DWORD PTR SS:[oldToNewStore]
            POP offReg
            POP segReg
done:
            ENDM

;****************************************************************************
; SOCKPRIM.ASM
;               The V286 Socket Primitives V2.0
;               In this implementation, recv() and accept() only operate in
;               a nonblocking fashion, returning errno EWOULDBLOCK if the
;               operation can not be completed immediately.  All other calls
;               block until completion or error.è;               Opcode 0 is implemented in this version as Socket closeAll.
;               Opcode 18 is implemented in this version as Socket version.
;               An additional non-standard errno EDRIVER (254) is returned if
;               installation fails or the installed driver behaves strangely.
;****************************************************************************
;
TITLE Socket Primitives
.286P
            INCLUDE fixdptrs.usr
            INCLUDE objects.usr
            INCLUDE access.usr

            INCLUDE sockprim.inc

code        SEGMENT PUBLIC 'CODE'
            ASSUME CS:code,DS:nothing,ES:nothing

PGROUP  GROUP   CODE

;****************************************************************************
;               Smalltalk/V286 Reserved Area
;****************************************************************************
;
            ORG 0
            DW OFFSET install   ;installation routine entry point

            DW 0                                ;reserved for future use
            DW 0

                        DW 0                    ;real mode segment of this code

            DW OFFSET primTable ;addr of table of primitives and entry points
            DW 0                   ;real mode segment address of protected mode
                                   ;parameter area

            DW 0                   ;cell used for real mode calls to VM
            DW 0

;****************************************************************************
;               Local Data
;****************************************************************************
;
initialized_flag        DW      0
Socket_PB                       DB      32 DUP (0)
Name_Buffer                     DB      MAX_NAME_SIZE DUP (0)
Data_Buffer                     DB      MAX_BUFFER_SIZE DUP (0)

;****************************************************************************
;               The socketPrimitive operation dispatcher
;****************************************************************************
;
socketPrimitive    PROC   FAR
;
;   Dispatch the socket primitive specified by opcode.
;       PARAM(1) is the opcode
;       PARAM(2) is the argumentArrayè;
            enterPrimitive
            isSmallPosInt <WORD PTR [BP+arg1ptr+2]> ;opcode SmallInteger?
            JE              ok_opcode
            FAIL                                      ;FAIL if not
ok_opcode:
            MOV             AX,initialized_flag       ;perform initialization
            OR              AX,AX
            JNE             initialized
            PUSH    BP
            CALL    socket_install
            POP             BP
            CMP             AX,0
            JE              initialized
            SUCCEED_ERROR
initialized:
             MOV             AX,     WORD PTR [BP+arg1ptr]   ;opcode
;
;       check opcode bounds
;
                CMP             AX,0
                JL              exit_FAIL
                CMP             AX,MAX_OPCODE
                JG              exit_FAIL
                SHL             AX,1
                MOV             SI,AX
;
;       dispatch operation
;
                MOV             AX,WORD PTR DS:[Socket_Primitives+SI]
                JMP             AX
                SUCCEED_POSITIVE_INTEGER

exit_FAIL:
                FAIL

socketPrimitive ENDP

;****************************************************************************
;       The socket event handler - called by resident driver in real mode
;****************************************************************************
;
socket_event_handler    PROC    FAR
                MOV             AX,Network_VMInterrupt
                ISVinterruptVM
                RET
socket_event_handler    ENDP

;****************************************************************************
;               General purpose success exit
;               AX = integer value to be returned (positive or negative)
;****************************************************************************
;
;SUCCEED_INTEGER        PROC    NEAR
;               CMP             AX,0è;               JL              SUCCEED_NEGATIVE
;               SUCCEED_POSITIVE_INTEGER
;SUCCEED_NEGATIVE:
;               SUCCEED_NEGATIVE_INTEGER
;SUCCEED_INTEGER        ENDP

;****************************************************************************
;               Install Socket Event Handler - called automatically by dispatch
;****************************************************************************
;
socket_install  PROC    NEAR
                MOV             AX,1
                MOV             SI,OFFSET initialized_flag
                MOV             DS:[SI],AX
;
                SET_PB_FOR      OPCODE_register_event_handler
                MOV             WORD PTR DS:PB_Event_Handler[BX],OFFSET socket_event_handler
                MOV             AX,DS:[realCodeSeg]
                MOV             WORD PTR DS:PB_Event_Handler+2[BX],AX
;
                MOV             BYTE PTR DS:PB_errno[BX],EDRIVER
                MOV             WORD PTR DS:PB_Return_Code[BX],-1
;
                CALL_NETWORK
                RET
socket_install  ENDP

;****************************************************************************
;               The socket operations
;****************************************************************************

op_unimplemented        PROC    NEAR
                MOV             AX,EINVAL
                SET_errno
                SUCCEED_ERROR
op_unimplemented        ENDP

op_closeAll                     PROC    NEAR
                SET_PB_FOR      OPCODE_socket_close_all
;
                CALL_NETWORK
                SUCCEED_INTEGER
op_closeAll                     ENDP

;****************************************************************************
;               deinstall() - perform required cleanup before Smalltalk/V exit
;****************************************************************************
;
op_deinstall    PROC    NEAR
                MOV             AX,0
                MOV             SI,OFFSET initialized_flag
                MOV             DS:[SI],AX
;
                SET_PB_FOR      OPCODE_register_event_handler
                MOV             WORD PTR DS:PB_Event_Handler[BX],0è                MOV             WORD PTR DS:PB_Event_Handler+2[BX],0
;
                CALL_NETWORK
                SUCCEED_INTEGER
op_deinstall    ENDP

;****************************************************************************
;               socket()
;               ARG 1   Address_Format
;               ARG 2   Type
;               ARG 3   Protocol
;****************************************************************************
;
op_socket                       PROC    NEAR
                SET_PB_FOR      OPCODE_socket
;
                GET_POSITIVE_INTEGER_ARG        1
                MOV             DS:PB_Address_Format[BX],AX
;
                GET_POSITIVE_INTEGER_ARG        2
                MOV             DS:PB_Type[BX],AX
;
                GET_POSITIVE_INTEGER_ARG        3
                MOV             DS:PB_Protocol[BX],AX
;
                CALL_NETWORK            ;sets errno, result in AX
                SUCCEED_INTEGER
op_socket                       ENDP

                 *
                 *
                 *

;=================================================================
; doEthernetInt
;    This procedure executes in REAL MODE. The parameter block has
;    been filled. setup es:bx to point to the parameter block and
;    call the ethernet driver.

doEthernetInt   PROC    FAR
        PUSH    AX                              ; Save registers
        PUSH    BX                              ;
        PUSH    ES                              ;
        MOV             AX,CS                   ;
        MOV             ES,AX                   ; es points to this segment
        MOV             BX, OFFSET Socket_PB    ; bx contains offset to pblock
        INT             Resident_Driver_Interrupt       ; call driver
        POP             ES                              ; restore registers
        POP             BX                              ;
        POP             AX                              ;
        RET
doEthernetInt   ENDP

;table of primitive names and entry points
primTable:è            DB  'socketPrimitive'          ;Smalltalk name of primitive
            DB 0
            DW offset socketPrimitive      ;offset of entry point
;
;     more entries can go here

            DW 0                           ;end of table

;installation routine, called at the time the module is loaded
install     PROC FAR
            ret                            ;we have nothing to do, so return
install     endp

code        ENDS
            END