home *** CD-ROM | disk | FTP | other *** search
/ Millennium Time Capsule / AC2000.BIN / disks / hbasic_1 / ooplib / oopv0_1.s < prev   
Text File  |  1994-08-03  |  15KB  |  561 lines
  1.     opt    l+,c+
  2.  
  3. *
  4. * Object Oriented Programming Library for HiSoft Basic.
  5. * Version 0.1 - Only classes & attributes are available.
  6. *
  7. * See accompanying docs for details.
  8. *
  9. * This library was written using DevpacST, the HiSoft assembly language
  10. * development system.
  11. *
  12. *===========================================================================
  13.  
  14. max_object_size    EQU    100    ;100byte object size = 25 long ints
  15. max_classes    EQU    20    ;maximum numberof classes available
  16. class_namesize    EQU    8    ;8char class names
  17. ct_entry    EQU    100    ;100bytes per class table entry
  18.                 ;<8char name><2byte blank><2byte attrib count><attrib names, 8bytes each>
  19. ct_name        EQU    0
  20. ct_null        EQU    8
  21. ct_constructor    EQU    10
  22. ct_attrib_count    EQU    14
  23. ct_attribs    EQU    12
  24. attrib_name_size    EQU    8    ;Length of attribute names
  25. ot_entry    EQU    10    ;10bytes per object table entry
  26.                 ;<2byte type><4byteaddress><6bytes unallocated>
  27. ot_type        EQU    0
  28. ot_address    EQU    2
  29. os_type        EQU    0    ;each object in the store has the type filled in here
  30. os_attribs    EQU    2    ;start of the attribute area of the object
  31.  
  32. * Malloc #size, variable
  33. Malloc    macro
  34.     move.l    \1,-(a7)
  35.     move.w    #$48,-(a7)
  36.     trap    #1
  37.     addq.l    #6,a7
  38.     move.l    d0,\2
  39.     endm
  40.  
  41. * 8) print '<string>'
  42. print    macro
  43.     lea.l    x\@(pc),a0
  44.     bsr    prnt
  45.     bra    y\@
  46. x\@    dc.b    \1,0
  47.     cnop    0,2
  48. y\@    nop
  49.     endm
  50.  
  51.     include    library.h    the standard library include file
  52.  
  53.     library    OOP        library name
  54.  
  55.     xref    get_string    external references
  56.     xref    get_array
  57.     xref    make_string
  58.     xref.l    gl_scratch    this is referenced off global!
  59.  
  60.     xdef    init_oop
  61.     xdef    declare_objects
  62.     xdef    class
  63.     xdef    object
  64.     xdef    delete_object
  65.     xdef    o_iset
  66.     xdef    o_iget
  67.     xdef    flush_objects
  68.  
  69.     subdef    lng        init_oop    Initialise the OOP system
  70.     subdef    lng        declare_objects    How many objects do we think we'll be using?
  71.     subdef    str,str,lng    class        Define a new class
  72.     fn_lng    str        object        Instantiate an object of a class & return a pointer to it
  73.     subdef    lng        delete_object    Delete an object
  74.     subdef    lng,str,lng    o_iset        Set the value of an attribute.
  75.     fn_lng    lng,str        o_iget        Get the value of an attribute.
  76.     subdef    lng        flush_objects    Flush the object store & retreive empty space
  77.  
  78.     option    'uv'        underlines & variable checks
  79.  
  80.     libstart        the code follows
  81.  
  82.     opt D+
  83.  
  84. *====================================================================================
  85. * Initialise the OOP run-time system
  86. *====================================================================================
  87. init_oop:
  88.     lea.l    this(pc),a0
  89.     move.l    4(sp),(a0)    ;Set the this global
  90.     rts
  91.  
  92. *====================================================================================
  93. * Set up the object store by allocating memory
  94. *====================================================================================
  95. declare_objects:
  96.     Malloc    #ct_entry*max_classes,d2    ;allocate entries in class table
  97.     lea.l    class_table(pc),a0
  98.     move.l    d2,(a0)
  99.     move.l    d2,a0
  100.     clr.l    (a0)
  101.     lea.l    next_class(pc),a0        ;initialise the next class pointer
  102.     move.l    d2,(a0)
  103.  
  104.     cmp.l    #0,d2
  105.     beq    declare_report_error
  106.  
  107.     move.l    4(sp),d1
  108.  
  109.     subq.l    #1,d1
  110.  
  111.     mulu    #ot_entry,d1            ;allocate the object table
  112.  
  113.     lea.l    object_table_size(pc),a0    ;store the max number of objects (size of object table)
  114.     move.l    d1,(a0)
  115.  
  116.     add.l    #ot_entry,d1
  117.  
  118.     Malloc    d1,d2
  119.     lea.l    ot_next(pc),a0            ;first object goes at start of ot
  120.     move.l    d2,(a0)
  121.     lea.l    object_table(pc),a0        ;set pointer to ot in variable area
  122.     move.l    d2,(a0)
  123.     move.l    d2,a0
  124.     clr.l    (a0)                ;set first ot entry = null
  125.     
  126.     cmp.l    #0,d2
  127.     beq    declare_report_error
  128.  
  129.     mulu    #max_object_size,d1        ;allocate object storage
  130.     lea.l    object_store_size(pc),a0
  131.     move.l    d1,(a0)
  132.     Malloc    d1,d2
  133.     lea.l    next_object(pc),a0        ;first object at start of object store
  134.     move.l    d2,(a0)
  135.     lea.l    object_store(pc),a0
  136.     move.l    d2,(a0)
  137.     move.l    d2,a0
  138.     clr.l    (a0)
  139.  
  140.     cmp.l    #0,d2
  141.     beq    declare_report_error
  142.  
  143.     rts
  144. declare_report_error:
  145.     print    'OOP_error[1]-unable_to_allocate_object_storage.'
  146.     rts
  147.  
  148. *====================================================================================
  149. * Create a new class
  150. *====================================================================================
  151. class:
  152.     move.l    12(sp),a0        ;pointer to class name
  153.     bsr    get_string        ;D4 contains length of attributes string
  154.     move.l    a1,d1
  155.  
  156.     lea.l    next_class(pc),a0
  157.     move.l    (a0),a1            ;location of next class table entry
  158.     move.l    d1,a0
  159.     move.w    #0,ct_null(a1)        ;null entry in table
  160.  
  161.     cmp.l    #class_namesize,d4    ;8char class names
  162.     blt    cn_oksize
  163.     move.l    #class_namesize,d4
  164.  
  165. cn_oksize:
  166.     subq.w    #1,d4
  167. cn_to_table_loop:            ;copy class_name into class table
  168.     move.b    (a0)+,(a1)+
  169.     dbf    d4,cn_to_table_loop
  170.     move.b    #0,(a1)            ;zero terminate the string
  171. ;get the attributes now
  172.     move.l    8(sp),a0        ;pointer to class attributes
  173.     bsr    get_string        ;D4 contains length of attributes string
  174.     move.l    a1,d1
  175.  
  176.     lea.l    next_class(pc),a0
  177.     move.l    (a0),a1            ;location of next class table entry
  178.  
  179.     add.l    #ct_attribs,a1
  180.     move.l    d1,a0
  181.  
  182.     move.w    #0,d5            ;d5=#attributes
  183. copy_attribs:
  184.     bsr    get_this_attrib
  185.  
  186.     cmp.w    #0,d4
  187.     bne    copy_attribs
  188.  
  189.     move.b    #0,(a1)            ;zero terminate the string
  190.  
  191.     lea.l    next_class(pc),a1
  192.     move.l    d1,a0
  193.     move.w    d5,ct_attrib_count(a0)
  194.  
  195.     move.l    4(sp),ct_constructor(a0)    ;fill in default constructor field
  196.  
  197.     move.l    (a1),a0
  198.  
  199.     lea.l    next_class(pc),a1
  200.     move.l    (a1),a0
  201.     add.l    #ct_attribs,a0
  202.  
  203.     lea.l    next_class(pc),a1    ;Update next class pointer to next slot in ct
  204.     move.l    (a1),d1
  205.  
  206.     add.l    #ct_entry,d1
  207.     move.l    d1,(a1)
  208.  
  209.     rts
  210.  
  211. get_this_attrib:
  212.     addq.w    #1,d5            ;increment attribute count
  213.     move.w    #0,d0
  214. attr_to_table:                ;copy an attribute accross
  215.     move.b    (a0)+,(a1)+
  216.     addq.w    #1,d0            ;increment number of chars in current attrib
  217.     subq.w    #1,d4            ;decrement number of chars remaining in attrib list
  218.  
  219.     cmp.w    #0,d4            ;ahh. end of attributes list
  220.     ble    attr_pad
  221.  
  222.     cmp.b    #',',(a0)        ;comma seperator, begin a new attrib.
  223.     bne    xxx_1
  224.  
  225.     add.l    #1,a0            ;skip the comma
  226.     subq.w    #1,d4            ;account for comma in string length count
  227.     bra    attr_pad        ;jump to pad out
  228.  
  229. xxx_1:
  230.     cmp.b    #attrib_name_size,d0    ;got max chars - so we're clipping
  231.     bne    gta_loop        ; else continue to get more
  232.  
  233.     bra    gta_end            ;got a full attrib name
  234.  
  235. attr_pad:
  236.     cmp.b    #attrib_name_size,d0    ;got max chars - so we're clipping
  237.     beq    gta_end            ;if not, pad with spaces
  238.     move.b    #' ',(a1)+
  239.     addq.w    #1,d0
  240.     bra    attr_pad
  241.  
  242. gta_loop:
  243.     bra    attr_to_table
  244. gta_end:
  245.     rts
  246.  
  247. *====================================================================================
  248. * Create an object of a class
  249. *====================================================================================
  250. object:
  251.     move.l    4(sp),a0        ;pointer to class attributes
  252.     bsr    get_string        ;D4 contains length of attributes string
  253.  
  254.     clr.l    d0            ;d2=number of characters matched
  255.  
  256.     movem.l    a3-a6,-(sp)
  257.  
  258.     move.l    a1,a4            ;keep a copy of class name
  259.  
  260.     move.w    #1,d5            ;class id
  261.  
  262.     lea.l    class_table(pc),a3
  263.     move.l    (a3),a0            ;a0 points to start of class table
  264. find_class:
  265.     cmp.l    d0,d4            ;have we found the target in the ct ?
  266.     beq    end_of_target
  267.  
  268.     move.b    (a1,d0),d1        ;get char from target
  269.     move.b    (a0,d0),d2        ;get char from ct
  270.  
  271.     addq.w    #1,d0
  272.     cmp.w    #class_namesize+1,d0    ;exceeded class name field - must be this class
  273.     beq    got_class
  274.  
  275.     cmp.b    d1,d2            ;still matches so continue loop
  276.     beq    find_class
  277. fc_not_this_one:
  278.     add.l    #ct_entry,a0        ;next class table entry
  279.     cmp.b    #0,(a0)            ;end of table ?
  280.     beq    class_not_found        ;bum out
  281.     addq.w    #1,d5            ;next class id
  282.     clr.w    d0
  283.     bra    find_class
  284.  
  285. end_of_target:
  286.     move.b    (a0,d0),d2        ;end of target string. is next char in ct a 0?
  287.     cmp.b    #0,d2            ; if so then we have a match, 0 used as terminator
  288.     bne    fc_not_this_one
  289.  
  290. got_class:
  291.     lea.l    ot_next(pc),a0        ;pointer to next free ot entry
  292.     move.l    (a0),a1
  293.  
  294.     move.l    a1,d0
  295.  
  296.     lea.l    object_table_size(pc),a6    ;get the size of the object table
  297.     move.l    (a6),d1
  298.     lea.l    object_table(pc),a6    ;get the start of the object table
  299.     add.l    (a6),d1            ;end of ot in d1
  300.  
  301.     cmp.l    d1,a1            ;is ot full? if so, we'll have to scan for a space.
  302.     blt    rtn_scan_ot_for_space
  303.     move.l    d1,(a0)            ;flag ot_next as always being full
  304.     bra    scan_ot_for_space
  305.  
  306. rtn_scan_ot_for_space:
  307.     move.l    a1,d1            ;calculate object store slot from
  308.     lea.l    object_table(pc),a2    ;object table slot.
  309.     move.l    (a2),d2
  310.     sub.l    d2,d1
  311.     divu    #ot_entry,d1
  312.     and.l    #$0000ffff,d1
  313.     mulu    #max_object_size,d1
  314.     lea.l    object_store(pc),a2
  315.     move.l    (a2),a3
  316.     adda.l    d1,a3
  317.  
  318.     move.w    d5,os_type(a3)        ;tag object with it's type id
  319.  
  320.     move.w    d5,ot_type(a1)        ;fill object type field in ot
  321.     move.l    a3,ot_address(a1)    ;fill in object address field in ot
  322.  
  323.     move.l    a1,tos            ;return pointer to object table entry
  324.  
  325.     add.l    #max_object_size,a3    ;update next_object
  326.     lea.l    next_object(pc),a2    ;pointer to next object
  327.     move.l    a3,(a2)
  328.     add.l    #ot_entry,a1        ;update ot_next
  329.     move.l    a1,(a0)
  330.  
  331.     movem.l    (sp)+,a3-a6
  332.     rts
  333.  
  334. scan_ot_for_space:
  335.     lea.l    object_table(pc),a6    ;start scan at base of ot
  336.     move.l    (a6),a1
  337. scan_ot_loop:
  338.     cmp.w    #0,ot_type(a1)        ;is ot entry empty?
  339.     beq    rtn_scan_ot_for_space
  340.  
  341.     cmp.l    a1,d1            ;have we run out of ot space?
  342.     blt    no_ot_space_left
  343.  
  344.     add.l    #ot_entry,a1        ;check next slot
  345.     bra    scan_ot_loop
  346.  
  347. no_ot_space_left:
  348.     print    'OOP_error[2]-Object_Table_full_-_declare_more_object_space'
  349.     move.l    #0,tos            ;return 0 as error
  350.     movem.l    (sp)+,a3-a6
  351.     rts
  352.     
  353. class_not_found:
  354.     print    'OOP_error[3]-Class_used_before_defined'
  355.     move.l    #0,tos            ;return 0 as error
  356.     movem.l    (sp)+,a3-a6
  357.     rts
  358.  
  359. *====================================================================================
  360. * Declare an object of a class.
  361. *====================================================================================
  362. delete_object:
  363.     move.l    4(sp),a0        ;pointer to ot entry
  364.     move.l    ot_address(a0),a1    ;pointer to object store entry
  365.     move.w    #0,ot_type(a0)        ;mark object table entry as unused
  366.     move.w    #0,os_type(a1)        ;mark object as deleted (class id = 0)
  367.     rts
  368.  
  369. *====================================================================================
  370. * Set the value of an attribute in an object
  371. *====================================================================================
  372. o_iset:
  373.     clr.l    d0
  374.     move.l    4(sp),d7        ;the long int value to set
  375.     move.l    8(sp),a0
  376.     bsr    get_string        ;a1 points to name of attribute
  377.     move.l    12(sp),a0        ;get pointer to object
  378.     move.w    ot_type(a0),d0        ;get object type
  379.     subq.w    #1,d0
  380.     mulu.w    #ct_entry,d0        ;offset to class table entry for this id
  381.  
  382.     lea.l    class_table(pc),a2
  383.     add.l    (a2),d0            ;class table address
  384.     move.l    d0,a2            ;pointer to class table entry
  385.  
  386.     move.l    ct_attrib_count(a2),d1    ;d1=number of attributes available
  387.  
  388.     add.l    #ct_attribs,a2        ;a2=pointer to start of attribute name area
  389.  
  390.     move.l    #0,d6            ;d6=count of how many attribs we've looked at so far
  391.  
  392. sfind_attribute:
  393.     move.w    #0,d2
  394. sscan_along_attribute_name:
  395.     move.b    (a2,d2),d3        ;first char of attrib name
  396.     move.b    (a1,d2),d5
  397.  
  398.     cmp.b    d2,d4            ;have we reached end of parameter
  399.     beq    smatched_the_param
  400.  
  401.     cmp.b    d3,d5            ;names don't match
  402.     bne    snext_name
  403.  
  404.     addq.w    #1,d2
  405.  
  406.     cmp.w    #attrib_name_size,d2
  407.     beq    sgot_the_right_attribute
  408.  
  409.     bra    sscan_along_attribute_name
  410.  
  411. smatched_the_param:
  412.     cmp.w    #attrib_name_size,d4
  413.     beq    sgot_the_right_attribute
  414.  
  415.     move.b    1(a2,d2),d3
  416.     cmp.b    #' ',d3
  417.     beq    sgot_the_right_attribute
  418.  
  419. snext_name:
  420.     add.l    #attrib_name_size,a2
  421.     addq.w    #1,d6
  422.     cmp.w    d6,d1            ;have we looked at all the attribs ?
  423.     beq    attrib_not_found
  424.  
  425.     bra    sfind_attribute
  426.  
  427. sgot_the_right_attribute:
  428.     lsl.l    #2,d6
  429.     move.l    ot_address(a0),a1
  430.     move.l    d7,os_attribs(a1,d6)
  431.     rts
  432.  
  433. *====================================================================================
  434. * Get an attribute value from an object
  435. *====================================================================================
  436. o_iget:
  437.     clr.l    d0
  438.     move.l    4(sp),a0
  439.     bsr    get_string        ;a1 points to name of attribute
  440.     move.l    8(sp),a0        ;get pointer to object
  441.     move.w    ot_type(a0),d0        ;get object type
  442.     subq.w    #1,d0
  443.     mulu.w    #ct_entry,d0        ;offset to class table entry for this id
  444.  
  445.     lea.l    class_table(pc),a2
  446.     add.l    (a2),d0            ;class table address
  447.     move.l    d0,a2            ;pointer to class table entry
  448.  
  449.     move.l    ct_attrib_count(a2),d1    ;d1=number of attributes available
  450.  
  451.     add.l    #ct_attribs,a2        ;a2=pointer to start of attribute name area
  452.  
  453.     move.l    #0,d6            ;d6=count of how many attribs we've looked at so far
  454.  
  455. find_attribute:
  456.     move.w    #0,d2
  457. scan_along_attribute_name:
  458.     move.b    (a2,d2),d3        ;first char of attrib name
  459.     move.b    (a1,d2),d5
  460.  
  461.     cmp.b    d2,d4            ;have we reached end of parameter
  462.     beq    matched_the_param
  463.  
  464.     cmp.b    d3,d5            ;names don't match
  465.     bne    next_name
  466.  
  467.     addq.w    #1,d2
  468.  
  469.     cmp.w    #attrib_name_size,d2
  470.     beq    got_the_right_attribute
  471.  
  472.     bra    scan_along_attribute_name
  473.  
  474. matched_the_param:
  475.     cmp.w    #attrib_name_size,d4
  476.     beq    got_the_right_attribute
  477.  
  478.     move.b    1(a2,d2),d3
  479.     cmp.b    #' ',d3
  480.     beq    got_the_right_attribute
  481.  
  482. next_name:
  483.     add.l    #attrib_name_size,a2
  484.     addq.w    #1,d6
  485.     cmp.w    d6,d1            ;have we looked at all the attribs ?
  486.     beq    attrib_not_found
  487.  
  488.     bra    find_attribute
  489.  
  490. got_the_right_attribute:
  491.     lsl.l    #2,d6
  492.     move.l    ot_address(a0),a1
  493.     move.l    os_attribs(a1,d6),tos
  494.     rts
  495.  
  496. attrib_not_found:
  497.     print    'OOP_error[4]-attrib_not_found'
  498.     move.l    #0,tos
  499.     rts
  500.  
  501. *====================================================================================
  502. * Flush object store
  503. *====================================================================================
  504. flush_objects:
  505. *    clr.l    d0
  506. *    lea.l    object_store_size(pc),a0
  507. *    move.l    (a0),d1
  508. *
  509. *    lea.l    object_store(pc),a0
  510. *    move.l    (a0),a1
  511. *    move.l    a1,a0
  512. *
  513. *    cmp.l    d0,d1            ;have we looked at the whole object store?
  514. *    blt    finished_flush
  515. *
  516. *flush_:
  517. *    cmp.w    #0,os_type(a0)        ;have we encountered an empty slot?
  518. *    beq    flush_skip1
  519. *    add.w    #max_object_size,d0    ;yes, so skip it and continue
  520. *    bra    flush_skip_blanks
  521. *
  522. *flush_skip1:
  523. *    move.w    #(max_object_size/4)-1,d2
  524. *flush_loop:
  525. *    move.l    (a0,d0),(a0)+
  526. *    dbra    d2,flush_loop
  527. *
  528. *finished_flush:
  529.     print 'flushed_the_object_store'
  530.     move.l    #0,tos
  531.     rts
  532.  
  533. *print a string
  534. prnt          movem.l a0-a3/d0-d5,-(a7)
  535.                move.l a0,-(a7)
  536.                move.w #9,-(a7)
  537.                trap #1
  538.                addq.l #6,a7
  539.                movem.l (a7)+,a0-a3/d0-d5
  540.                rts
  541.  
  542. object_table    dc.l    0    ;pointer to the object table
  543. object_table_size:        ;the size of the object table in bytes
  544.         dc.l    0
  545. ot_next        dc.l    0    ;pointer to next free entry in object table
  546. object_store    dc.l    0    ;pointer to the start of the first object store block
  547. object_store_size:
  548.         dc.l    0    ;the size of the object store.
  549. next_object:            ;pointer to the next free object store entry
  550.         dc.l    0
  551. class_temp_name    dc.l    0    
  552. class_temp_attribs:
  553.         dc.l    0
  554. class_table    dc.l    0    ;pointer to the class definition table
  555. next_class    dc.l    0    ;pointer to the next free entry in the class definition table
  556.  
  557. this        dc.l    0    ;pointer to the location of the current object when calling a service
  558.                 ;this is the location of the this& variable
  559.     END
  560.  
  561.