home *** CD-ROM | disk | FTP | other *** search
/ Il CD di internet / CD.iso / SOURCE / EXTRA-ST / CPM-80-E / CPM-0.2 / CPM-0 / cpm-0.2 / z80-sources / link / link.mac < prev    next >
Encoding:
Text File  |  1994-06-06  |  35.5 KB  |  1,700 lines
  1. ;************************************************************************
  2. ;*    History:                            *
  3. ;*    28.08.1987    Grundversion                    *
  4. ;*    28.02.1989    Cmd-Line Parser verbessert: L|schte Bildschirm    *
  5. ;*            bei Eingabe von lfw:Dateiname            *
  6. ;*            Au~erdem werden Dateinamen mit mehr als 8 Zei-    *
  7. ;*            chen jetzt akzeptiert (Rest ignoriert!) und    *
  8. ;*            '_'-Zeichen im Dateinamen auch.            *
  9. ;*            lfw: wird jetzt richtig ausgewertet        *
  10. ;*            l|scht den Speicher jetzt vor dem Linken!    *
  11. ;*            verschiedene Special-Link-Items werden jetzt    *
  12. ;*            erkannt (high(addr), low(addr)).        *
  13. ;*                                    *
  14. ;************************************************************************
  15.  
  16.         .z80            ;
  17. tab        equ 9            ;
  18. lf        equ 10            ;
  19. cr        equ 13            ;
  20.         maclib BDOSCALL.MLB    ;
  21.  
  22. print        macro text        ;
  23.           local txtaddr        ;
  24.           dseg            ;
  25. txtaddr:      db text,0        ;
  26.           cseg            ;
  27.           ld hl,txtaddr        ;
  28.           call txtout        ;
  29.         endm            ;
  30.  
  31.  
  32. clear_mem:    ld hl,(6)        ; BDOS - Start
  33.         ld de,($MEMRY)        ;
  34.         scf            ;
  35.         sbc hl,de        ; free mem length - 1
  36.         ld c,l            ;
  37.         ld b,h            ; BC := length - 1
  38.         ld l,e            ;
  39.         ld h,d            ; HL := ($MEMRY)
  40.         ld (hl),0        ;
  41.         inc de            ;
  42.         ldir            ;
  43.         ret            ;
  44.  
  45.         public $MEMRY        ;
  46.  
  47. entry:        print <cr,lf,"Z80-Linker Ver. 1.1  written Aug-1987 by M.Bischoff", cr, lf, lf>
  48. do_reset:    ld sp,stack        ;
  49.         call clear_mem        ;
  50.         call cmd_line_init    ;
  51.         ld hl,1100h        ;
  52. $MEMRY        equ $-2            ;
  53.         ld (prog_buf),hl    ;
  54.         call reset        ;
  55. main_loop:    ld sp,stack        ;
  56.         call get_cmd        ;
  57. check_option:    ld (txt_ptr),hl        ; store pointer
  58.         or a            ; end of line => load module
  59.         jr z,load_relfile    ;
  60.         cp ','            ; terminated with comma => load module
  61.         jr z,load_relfile    ;
  62.         cp '/'            ;
  63.         jr z,option        ;
  64.         inc hl            ;
  65.         ld a,(hl)        ;
  66.         call is_delim_2        ; blank, comma or slash
  67.         jr z,check_option    ;
  68.  
  69. cmd_error:    print "Bad Command: "    ;
  70.         ld hl,(txt_ptr)        ;
  71.         call txtout        ;
  72.         call crlf_out        ;
  73. abbruch:    ld hl,(txt_ptr)        ;
  74.         ld (hl),0        ;
  75.         jr main_loop        ;
  76.  
  77. option:        inc hl            ; steht auf Zeichen
  78.         inc hl            ; steht auf 1 weiter!
  79.         ld a,(hl)        ;
  80.         call is_delim_2        ; darf nur ',' oder '/' folgen
  81.         jp nz,cmd_error        ;
  82.         dec hl            ;
  83.         ld a,(hl)        ;
  84.         inc hl            ;
  85.         and 0dfh        ; to upper
  86.         cp 'N'            ;
  87.         jp z,name_outfile    ;
  88.         cp 'S'            ;
  89.         jp z,search_library    ;
  90.         cp 'R'            ;
  91.         jp z,do_reset        ; reset, don't load file before
  92.         ld e,a            ;
  93.         ld a,(user_fcb+1)    ; any file to load?
  94.         cp ' '            ; any filename?
  95.         jr nz,load_relfile    ; then skip option, do it later
  96.         ld a,e            ; resume other commands
  97.         cp 'U'            ;
  98.         jp z,list_undefineds    ;
  99.         cp 'M'            ;
  100.         jp z,list_defineds    ;
  101.         cp 'E'            ;
  102.         jp z,save_object    ;
  103.         cp 'O'            ; set to octal?
  104.         jr z,set_oct_hex    ;
  105.         cp 'H'            ; set to hexadecimal?
  106.         jr z,set_oct_hex    ;
  107.         jp cmd_error        ;
  108.  
  109. load_relfile:    call open_relfile    ;
  110. load_loop.1:    call load_module    ;
  111.         or a            ;
  112.         jr z,load_loop.1    ;
  113.         cp 1            ;
  114.         jp z,main_loop        ; end of file
  115.         jp abbruch        ;
  116.  
  117. open_relfile:    ld hl,user_fcb        ;
  118.         ld de,rel_fcb        ;
  119.         ld bc,24h        ;
  120.         ldir            ;
  121.         ld hl,rel_fcb+9        ;
  122.         ld a,(hl)        ;
  123.         or a            ;
  124.         jr nz,has_rel_ext    ;
  125.         ld (hl),'R'        ;
  126.         inc hl            ;
  127.         ld (hl),'E'        ;
  128.         inc hl            ;
  129.         ld (hl),'L'        ;
  130. has_rel_ext:    ld a,80h        ;
  131.         ld (bytecnt),a        ; set Buffer to beginning
  132.  
  133.         bdos open_file,rel_fcb    ;
  134.         cp 4            ;
  135.         ret c            ;
  136.         print "Cannot open file "
  137.         xor a            ;
  138.         ld (rel_fcb+13),a    ;
  139.         ld hl,rel_fcb+1        ;
  140.         call txtout        ;
  141.         call crlf_out        ;
  142.         jp abbruch        ;
  143.  
  144.         dseg            ;
  145. blank_fcb:    db 0,'        ',0,'  '    ; 1. Byte der Extension ist 0
  146.         ds 24h-12,0        ;
  147. user_fcb:    ds 24h,0        ;
  148.  
  149. txt_ptr:    dw 0            ;
  150.         cseg            ;
  151.  
  152. set_oct_hex:    ld (txt_ptr),hl        ; store new address
  153.         dec hl            ;
  154.         ld a,(hl)        ; extension of numbers
  155.         ld (number_ext),a    ;
  156.         res 5,a            ; make lower to upper
  157.         sub 'H'            ; hex is 
  158.         ld (octal_flag),a    ;
  159.         jp main_loop        ;
  160.  
  161. cmd_line_init:    ld hl,80h        ;
  162.         ld e,(hl)        ;
  163.         ld d,0            ;
  164.         inc hl            ;
  165.         ld (txt_ptr),hl        ;
  166.         add hl,de        ;
  167.         ld (hl),d        ;
  168.         ret            ;
  169.  
  170. is_alnum:    cp '_'            ; underscore erlaubt!
  171.         jr z,.isalnum1        ;
  172.         sub '0'            ;
  173.         cp 10            ;
  174.         ret c            ; disgit
  175.         sub 'A'-'0'        ;
  176.         cp 26            ;
  177.         ret c            ; Gro~buchstabe
  178.         sub 20h            ;
  179.         cp 26            ;
  180.         ret nc            ; kein alnum
  181.         res 5,(hl)        ; toupper!
  182. .isalnum1:    scf            ; true!
  183.         ret
  184.  
  185. is_delim_2:    cp '/'            ;
  186.         ret z            ;
  187. is_delim_1:    cp ','            ;
  188.         ret z            ;
  189. is_blank:    cp ' '            ;
  190.         ret z            ;
  191.         cp tab            ;
  192.         ret z            ;
  193.         or a            ;
  194.         ret            ;
  195.  
  196. get_cmd:    ld hl,(txt_ptr)        ;
  197. skip:        ld a,(hl)        ;
  198.         call is_delim_1        ; blank or comma skipped
  199.         jr nz,has_text        ;
  200.         inc hl            ; Zeiger auf n{chstes Zeichen!
  201.         or a            ;
  202.         jr nz,skip        ; any spaces, tabs, commas
  203.  
  204.         ld a,'*'        ; read more commands from console
  205.         call akku_out        ;
  206.         ld de,80h        ;
  207.         ld a,7ch        ;
  208.         ld (de),a        ;
  209.         bdos inline        ;
  210.         ld a,lf            ;
  211.         call crlf_out        ;
  212.         ld hl,80h        ;
  213.         xor a            ;
  214.         ld (hl),a        ;
  215.         inc hl            ;
  216.         ld e,(hl)        ;
  217.         ld d,a            ;
  218.         inc hl            ;
  219.         ld (txt_ptr),hl        ;
  220.         add hl,de        ;
  221.         ld (hl),d        ; 0
  222.         jr get_cmd        ;
  223.  
  224. has_text:    exx            ;
  225.         ld hl,blank_fcb        ;
  226.         ld de,user_fcb        ;
  227.         ld bc,24h        ;
  228.         ldir            ;
  229.         exx            ;
  230.         cp '/'            ; im Akku noch Zeichen!
  231.         ret z            ; HL steht auf n{chstem Zeichen
  232.         ; HL steht auf 1. Zeichen des Dateinamens!
  233. after_lfw:    and 0dfh        ; must be character
  234.         sub 'A'            ;
  235.         cp 26            ;
  236.         jp nc,cmd_error        ;
  237.         res 5,(hl)        ; wandele (HL) in Gro~buchstaben um!
  238.         inc hl            ;
  239.         ld c,a            ; speichern!
  240.         ld a,(hl)        ;
  241.         cp ':'            ; Laufwerksangabe?
  242.         ld a,c            ;
  243.         jr nz,no_lfw        ;
  244.         cp 16            ;
  245.         jp nc,cmd_error        ; Cp/M kennt nur A..P
  246.         ld a,(user_fcb)        ; hat schon Laufwerk?
  247.         or a            ;
  248.         jp nz,cmd_error        ; dann Fehler melden
  249.         ld a,c            ;
  250.         inc a            ;
  251.         ld (user_fcb),a        ;
  252.         inc hl            ; noch einen weiter => 1. Zeichen nach ':'
  253.         ld a,(hl)        ;
  254.         jr after_lfw        ; zweiter Versuch!
  255.  
  256. no_lfw:        add a,'A'        ;
  257.         ld de,user_fcb+1    ;
  258.         ld bc,8*256        ; C=0: no extension yet
  259. init_user_fcb:    ld (de),a        ;
  260.         inc de            ;
  261. after_ext:    ld a,(hl)        ;
  262.         call is_delim_2        ; blank, comma or slash
  263.         ret z            ;
  264.         cp '.'            ; Filename extension?
  265.         jr z,get_extension    ;
  266.         call is_alnum        ;
  267.         jp nc,cmd_error        ;
  268.         ld a,(hl)        ;
  269.         inc hl            ;
  270.         djnz init_user_fcb    ;
  271.         jr after_ext        ;nicht so nerv|s werden, Rest ignorieren
  272.         jp cmd_error        ;
  273.  
  274. get_extension:    bit 0,c            ; extension ?
  275.         jp nz,cmd_error        ; 2. nicht erlaubt
  276.         ld de,user_fcb+9    ; beg. of extension
  277.         ld b,4            ; 3 Zeichen erlaubt (last = error)
  278.         inc hl            ;
  279.         inc c            ; set extension
  280.         ld a,' '        ; bis jetzt keine Extension
  281.         ld (de),a        ; nur, um Default-Extension zu vermei-
  282.         jr after_ext        ; den
  283.  
  284.         dseg            ;
  285.         ds 200,0        ;
  286. stack:                    ;
  287.         cseg            ;
  288.  
  289. reset:        ld hl,(6)        ;
  290.         dec hl            ; letzte benutzbare Speicherzelle
  291.         ld (top_of_mem),hl    ;
  292.  
  293.         ld hl,103h        ; Default load addresses
  294.         ld (start_cseg),hl    ;
  295.         ld (start_dseg),hl    ;
  296.         ld (start_common),hl    ;
  297.  
  298.         ld hl,(prog_buf)    ; no Entry Point defined
  299.         ld (hl),0        ;
  300.         inc hl            ;
  301.         ld (hl),0        ;
  302.         inc hl            ;
  303.         ld (hl),0        ;
  304.         inc hl            ;
  305.         ld (top_load),hl    ; hoechste Ladeadresse
  306.  
  307.         ld hl,0            ; no Globals yet
  308.         ld (list_globals),hl    ;
  309.         ld (list_commons),hl    ;
  310.         ld (list_requests),hl    ;
  311.         ld hl,upn_stack
  312.         ld (upn_ptr),hl
  313.         ret            ;
  314.  
  315.  
  316.         dseg            ;
  317. base:        dw 0            ; true zero
  318. start_cseg:    dw 103h            ; cseg orign    ; USER addresses
  319. start_dseg:    dw 103h            ; dseg orign
  320. start_common:    dw 103h            ; common orign
  321.  
  322. size_cseg:    dw 103h            ; cseg size
  323. size_dseg:    dw 103h            ; dseg size
  324. size_common:    dw 103h            ; common size
  325. start_cseg_real:dw 103h            ; cseg orign    ; REAL addresses
  326. start_dseg_real:dw 103h            ; dseg orign    ; unused
  327. start_common_real:dw 103h        ; common orign
  328.  
  329. top_load:    dw 0            ;        ; REAL addresses
  330. top_of_mem:    dw 0            ;
  331. curr_mem:    dw 0            ;
  332.  
  333. list_globals:    dw 0            ; Pointer auf Anfang von verketteter
  334. list_commons:    dw 0            ; Liste alphabetisch sortierter
  335. list_requests:    dw 0            ; Globals, COMMONs, Requests
  336. list_explus:    dw 0            ;
  337.  
  338. prog_buf:    dw 0            ; begin of Program Buffer
  339. undefd_name:    db 0            ;
  340.         db '(undefined)',0    ;
  341. program_name:    db 0            ;
  342.         ds 16,0            ; for later!
  343. commonblock:    db 0            ;
  344.         ds 16,0            ;
  345.  
  346. searchfield:    dw 0            ; next-address
  347.         db 0            ; typebyte
  348. B_field:    db 0            ;
  349.         ds 16,0            ;
  350.         cseg            ;
  351.  
  352. ;************************************************************************
  353. ;*                                    *
  354. ;*        load_file: File is open and FCB on correct position    *
  355. ;*                                    *
  356. ;************************************************************************
  357.  
  358. load_module:    ld (saved_sp),sp    ; f}r den Fehlerfall...
  359.         ld a,0ffh        ; Beginne bei einer Bytegrenze
  360.         ld (relcnt),a        ;
  361.  
  362.         ld hl,undefd_name    ;
  363.         ld de,program_name    ; no Name defined
  364.         ld bc,17        ;
  365.         ldir            ;
  366.  
  367.         ld hl,0            ; no address specified
  368.         ld (start_cseg),hl    ; fuer's erste
  369.         jr load_loop        ;
  370.  
  371. load_gethl:    ld hl,(curr_mem)    ;
  372. load_loop:    call getbit        ;
  373.         jr nc,absolute_byte    ;
  374.         ld a,2            ;
  375.         call get_abits        ;
  376.         jr z,special_item    ;
  377.         push hl            ; load 16 Bit with offset
  378.         call read_16        ; read A-field is same
  379.         ex de,hl        ;
  380.         pop hl            ;
  381.         ld a,l            ; address OK?
  382.         or h            ;
  383.         jp z,e_no_addr        ; no!
  384.         ld (hl),e        ;
  385.         inc hl            ;
  386.         ld (hl),d        ;
  387.         inc hl            ;
  388.         jp pruef_mem        ;
  389.  
  390. absolute_byte:    ld a,l            ; address OK?
  391.         or h            ;
  392.         jp z,e_no_addr        ; no!
  393.         call get_byte        ;
  394.         ld (hl),a        ; save in memory
  395.         inc hl            ;
  396.  
  397. pruef_mem:    ex de,hl        ;
  398.         ld hl,(top_load)    ;
  399.         or a            ;
  400.         sbc hl,de        ;
  401.         ex de,hl        ;
  402.         jr nc,load_loop        ;
  403.  
  404. e_nomem:    ld hl,txt_no_mem    ;
  405.         jp rel_fehler        ;
  406.  
  407. special_item:    ld (curr_mem),hl    ;
  408.         ld a,4            ;
  409.         call get_abits        ;
  410.         ld hl,jp_table        ;
  411.         add hl,bc        ;
  412.         add hl,bc        ;
  413.         ld a,(hl)        ;
  414.         inc hl            ;
  415.         ld h,(hl)        ;
  416.         ld l,a            ;
  417.         jp (hl)            ;
  418.  
  419. jp_table:    dw get_entry_symbol    ;
  420.         dw sel_common        ;
  421.         dw store_name        ;
  422.         dw request_search    ;
  423.         dw reserved_B        ;
  424.  
  425.         dw def_common_size    ;
  426.         dw chain_external    ;
  427.         dw define_entry        ;
  428.         dw reserved_A        ;
  429.  
  430.         dw external_offset    ;
  431.         dw def_dseg_size    ;
  432.         dw set_loc_counter    ;
  433.         dw chain_address    ;
  434.         dw def_cseg_size    ;
  435.         dw end_program        ;
  436.  
  437.         dw end_file        ;
  438.  
  439. ;************************************************************************
  440. ;*                                    *
  441. ;*        verschiedene Programme, die Special Link        *
  442. ;*        Items ausfuehren                    *
  443. ;*                                    *
  444. ;************************************************************************
  445.  
  446. get_entry_symbol:call get_B_field    ; LINK item 0
  447.         jp load_gethl        ; ignore so far
  448.  
  449. sel_common:    call get_B_field    ; LINK item 1
  450.         call search_common    ;
  451.         jp nz,undefd_common    ;
  452.         ld (start_common),de    ;
  453.         jp load_gethl        ;
  454.  
  455. store_name:    call get_B_field    ; LINK item 2
  456.         ld hl,B_field        ;
  457.         ld de,program_name    ;
  458.         ld bc,17        ;
  459.         ldir            ;
  460.         jp load_gethl        ;
  461.  
  462. request_search:    call get_B_field    ; LINK item 3
  463.         call find_request    ;
  464.         jp load_gethl        ;
  465.  
  466.  
  467. pushde:        ld hl,(upn_ptr)
  468.         dec hl
  469.         ld (hl),d
  470.         dec hl
  471.         ld (hl),e
  472.         ld (upn_ptr),hl
  473.         ret
  474. popde:        ld hl,(upn_ptr)
  475.         ld e,(hl)
  476.         inc hl
  477.         ld d,(hl)
  478.         inc hl
  479.         ld (upn_ptr),hl
  480.         ret
  481.  
  482.         dseg
  483.         ds 20            ; Stack f}r special Link-items
  484. upn_stack:
  485. upn_ptr:    dw upn_stack
  486.         cseg
  487.  
  488. push_upn:    ld a,(hl)
  489.         ex de,hl
  490.         and 3            ; abs/cseg/dseg/common
  491.         add a,a
  492.         ld c,a
  493.         ld b,0
  494.         ld hl,base
  495.         add hl,bc        ; hl is offset
  496.         ld c,(hl)
  497.         inc hl
  498.         ld b,(hl)        ; BC is USER-Address
  499.         ex de,hl
  500.         inc hl
  501.         ld a,(hl)
  502.         add a,c            ; low byte (USER address)
  503.         ld e,a
  504.         inc hl
  505.         ld a,(hl)
  506.         adc a,b
  507.         ld d,a            ; high byte
  508.         call pushde
  509.         jp load_gethl
  510.  
  511.         dseg
  512. txt_abs_ex:    db 'FATAL: exp. abs. byte after L.I. 4', 0
  513.         cseg
  514.  
  515. fatal_absex:    ld hl,txt_abs_ex
  516.         call txtout
  517.         rst 0
  518.  
  519. sp4_A01:    call getbit
  520.         jr c,fatal_absex
  521.         call get_byte
  522.         call popde
  523.         ld hl,(curr_mem)
  524.         ld (hl),e
  525.         inc hl
  526.         jp pruef_mem
  527. sp4_A02:    call getbit
  528.         jr c,fatal_absex
  529.         call get_byte
  530.         call getbit
  531.         jr c,fatal_absex
  532.         call get_byte
  533.         call popde
  534.         ld hl,(curr_mem)
  535.         ld (hl),e
  536.         inc hl
  537.         ld (hl),d
  538.         inc hl
  539.         jp pruef_mem
  540. sp4_A03:    call popde
  541.         ld e,d
  542.         ld d,0
  543. upn_back:    call pushde
  544.         jp load_gethl
  545. sp4_A04:    call popde
  546.         ld d,0
  547.         jr upn_back
  548. sp4_A05:    call popde
  549.         ld a,e
  550.         cpl
  551.         ld e,a
  552.         ld a,d
  553.         cpl
  554.         ld d,a
  555.         jr upn_back
  556. sp4_A06:    call popde
  557.         ld hl,0
  558. sub_back:    or a
  559.         sbc hl,de
  560.         ex de,hl
  561.         jr upn_back
  562. sp4_A07:    call popde
  563.         push de
  564.         call popde
  565.         pop hl
  566.         ex de,hl    ; HL is now 2nd
  567.         jr sub_back
  568. sp4_A08:    call popde
  569.         push de
  570.         call popde
  571.         pop hl
  572.         add hl,de
  573.         ex de,hl
  574.         jr upn_back
  575.  
  576. do_ari:        ld a,(hl)
  577.         or a
  578.         jr z,sp4_unknown
  579.         dec a
  580.         jr z,sp4_A01
  581.         dec a
  582.         jr z,sp4_A02
  583.         dec a
  584.         jr z,sp4_A03
  585.         dec a
  586.         jr z,sp4_A04
  587.         dec a
  588.         jr z,sp4_A05
  589.         dec a
  590.         jr z,sp4_A06
  591.         dec a
  592.         jr z,sp4_A07
  593.         dec a
  594.         jr z,sp4_A08
  595.         jr sp4_unknown
  596.  
  597. push_external:    ld de,0
  598.         call pushde        ; um Stack-Konflikte zu vermeiden
  599.         jr sp4_unknown
  600.  
  601. reserved_B:    call get_B_field    ; LINK item 4
  602.         ld hl,B_field+1
  603.         ld a,(hl)
  604.         inc hl
  605.         cp 'A'            ; arithmetic?
  606.         jr z,do_ari
  607.         cp 'B'
  608.         jr z,push_external
  609.         cp 'C'
  610.         jp z,push_upn
  611. sp4_unknown:    ld hl,txt_special_4    ;
  612.         call txtout        ;
  613.         ld hl,(curr_mem)    ; derzeitige Ladeadresse
  614.         ld de,(prog_buf)
  615.         dec d
  616.         or a
  617.         sbc hl,de
  618.         ex de,hl
  619.         call hexout_de
  620.         ld hl,txt_special4a
  621.         call txtout
  622.         call prt_B_field    ;
  623.         jp load_gethl        ;
  624.  
  625. prt_B_field:    ld hl,B_field        ;
  626.         ld b,(hl)        ; > 0!
  627. B_prt_loop:    push bc
  628.         inc hl
  629.         ld a,(hl)
  630.         sub ' '
  631.         cp 5fh
  632.         jr c,.B_prt1
  633.         ld a,'/'
  634.         call akku_out
  635.         ld a,(hl)
  636.         call hexout_a
  637.         jr .B_prt2
  638. .B_prt1:    ld a,(hl)
  639.         call akku_out
  640. .B_prt2:    pop bc
  641.         djnz B_prt_loop
  642.         ld a,'>'
  643.         call akku_out
  644.         call crlf_out
  645.         ret
  646.  
  647. def_common_size:call get_A_field    ; LINK item 5
  648.         push hl            ;
  649.         call get_B_field    ;
  650.         call find_common    ;
  651.         jr z,has_common        ;
  652.  
  653.         pop bc            ; size
  654.         ld (hl),b        ;
  655.         dec hl            ;
  656.         ld (hl),c        ;
  657.         dec hl            ;
  658.         push hl            ;
  659.         ld hl,(top_load)    ;
  660.         ld de,(prog_buf)    ; make USER address
  661.         dec d            ;
  662.         or a            ;
  663.         sbc hl,de        ;
  664.         ex de,hl        ;
  665.         pop hl            ;
  666.         ld (hl),d        ;
  667.         dec hl            ;
  668.         ld (hl),e        ;
  669.         ld hl,(top_load)    ;
  670.         add hl,bc        ;
  671.         jp c,e_nomem        ; ERROR: Overflow total
  672.         ld (top_load),hl    ;
  673.         ld de,(top_of_mem)    ;
  674.         sbc hl,de        ;
  675.         jp c,load_gethl        ;
  676.         jp e_nomem        ; ERROR: Speicher voll
  677.  
  678. has_common:    ld a,(B_field)        ;
  679.         add a,5            ;
  680.         ld c,a            ; B is 0
  681.         add hl,bc        ;
  682.         ld e,(hl)        ;
  683.         inc hl            ;
  684.         ld d,(hl)        ;
  685.         pop hl            ; new size
  686.         scf            ;
  687.         sbc hl,de        ; must be C
  688.         jp c,load_gethl        ;
  689.  
  690.         ld hl,txt_2nd_larger    ;
  691.         call txtout        ;
  692.         ld hl,B_field+1        ;
  693.         call txtout        ;
  694.         ld hl,txt_2nd_2        ;
  695.         call txtout        ;
  696.         jp load_gethl        ;
  697.  
  698. chain_external:    call get_A_field    ; LINK item 6
  699.         push hl            ; head of address chain
  700.         call get_B_field    ; name
  701.         call find_global    ; search or create name in list
  702.         jr z,has_external    ;
  703.  
  704.         pop bc            ; head of chain
  705.         ld (hl),b        ;
  706.         dec hl            ;
  707.         ld (hl),c        ; store it
  708.         ex de,hl        ; HL= begin
  709.         inc hl            ;
  710.         inc hl            ; size/type - field
  711.         set 7,(hl)        ; mark as undefined
  712.         jp load_gethl        ;
  713.  
  714. has_external:    inc hl            ;
  715.         inc hl            ;
  716.         bit 7,(hl)        ; also undefined?
  717.         jr z,value_known    ;
  718.         dec hl            ; concatenate two undefineds
  719.         dec hl            ;
  720.         ld bc,(prog_buf)    ; start area
  721.         dec b            ; for offset 100h
  722. search_end:    ex de,hl        ; HL := value (head of old chain)
  723.         add hl,bc        ; REAL address
  724.         ld e,(hl)        ;
  725.         inc hl            ;
  726.         ld d,(hl)        ; DE := USER address
  727.         ld a,d            ;
  728.         or e            ;
  729.         jr nz,search_end    ;
  730.  
  731.         pop de            ;
  732.         ld (hl),d        ;
  733.         dec hl            ;
  734.         ld (hl),e        ;
  735.         jp load_gethl        ;
  736.  
  737. value_known:    ld c,e            ; DE is value (from search)
  738.         ld b,d            ; BC := value of Global
  739.         pop de            ; USER address of first in chain
  740.         jr define_it        ;
  741.  
  742. define_entry:    call get_A_field    ; LINK item 7
  743.         push hl            ; value
  744.         call get_B_field    ;
  745.         call find_global    ;
  746.         jr z,had_global        ;
  747.  
  748.         pop de            ; value
  749.         ld (hl),d        ;
  750.         dec hl            ;
  751.         ld (hl),e        ;
  752.         jp load_gethl        ;
  753.  
  754. had_global:    inc hl            ;
  755.         inc hl            ;
  756.         bit 7,(hl)        ;
  757.         jr z,redefinition    ;
  758.         res 7,(hl)        ;
  759.         ld c,(hl)        ;
  760.         inc hl            ;
  761.         add hl,bc        ;
  762.         pop bc            ; Value of now defined
  763.                     ; BC = USER value, HL points to chain
  764. replace_loop:    ld e,(hl)        ; Chain of undefineds
  765.         ld (hl),c        ;
  766.         inc hl            ;
  767.         ld d,(hl)        ;
  768.         ld (hl),b        ;
  769. define_it:    ld a,d            ;
  770.         or e            ;
  771.         jp z,load_gethl        ; all done, exit
  772.         ld hl,(prog_buf)    ;
  773.         dec h            ;
  774.         add hl,de        ; HL := REAL address of new
  775.         jp replace_loop        ;
  776.  
  777. redefinition:    push hl            ;
  778.         print "**** Warning! Global "
  779.         ld hl,B_field+1        ;
  780.         call txtout        ;
  781.         print <" redefined ****",cr,lf,"(Old value = ">
  782.         pop hl            ;
  783.         ld c,(hl)        ;
  784.         ld b,0            ;
  785.         add hl,bc        ;
  786.         inc hl            ;
  787.         ld e,(hl)        ;
  788.         inc hl            ;
  789.         ld d,(hl)        ;
  790.         call hexout_de        ;
  791.         print ", new value = "    ;
  792.         pop de            ;
  793.         call hexout_de        ;
  794.         print <")  Error ignored",cr,lf>
  795.         jp load_gethl        ;
  796.  
  797. reserved_A:    call get_A_field    ; LINK item 8
  798.         ld hl,txt_special_8    ;
  799.         call txtout        ;
  800.         jp load_gethl        ;
  801.  
  802. external_offset:call get_A_field    ; LINK item 9
  803.         push hl            ;
  804.  
  805.         ld hl,(top_of_mem)    ;
  806.         ld de,-6        ;
  807.         add hl,de        ;
  808.         ld (top_of_mem),hl    ;
  809.         ex de,hl        ;
  810.         ld hl,(top_load)    ;
  811.         or a            ;
  812.         sbc hl,de        ; NC!!!
  813.         jp nc,e_nomem        ;
  814.         inc de            ;
  815.         ld hl,(list_explus)    ;
  816.         ld (list_explus),de    ; zeigt auf neuen
  817.         ex de,hl        ; HL := &new
  818.         pop bc            ;
  819.  
  820.         ld (hl),e        ; store next-ptr
  821.         inc hl            ;
  822.         ld (hl),d        ;
  823.         inc hl            ;
  824.         ld de,(curr_mem)    ; REAL address
  825.         ld (hl),e        ;
  826.         inc hl            ;
  827.         ld (hl),d        ;
  828.         inc hl            ;
  829.         ld (hl),c        ; store address field (offset)
  830.         inc hl            ;
  831.         ld (hl),b        ;
  832.         jp load_gethl        ;
  833.  
  834. def_dseg_size:    call get_A_field    ; LINK item 10
  835.         ld (size_dseg),hl    ;
  836.         ld de,(top_load)    ;
  837.         ld (start_dseg_real),de    ;
  838.         add hl,de        ;
  839.         ld (top_load),hl    ;
  840.         ld de,(top_of_mem)    ;
  841.         or a            ;
  842.         sbc hl,de        ;
  843.         jp nc,e_nomem        ;
  844.         ld hl,(start_dseg_real)    ;
  845.         ld bc,(prog_buf)    ;
  846.         dec b            ;
  847.         or a            ;
  848.         sbc hl,bc        ; "NULL" abziehen
  849.         ld (start_dseg),hl    ;
  850.         jp load_gethl        ;
  851.  
  852. set_loc_counter:call get_A_field    ; LINK item 11
  853.         ld de,(prog_buf)    ;
  854.         dec d            ; get correct offset
  855.         add hl,de        ;
  856.         jp load_loop        ;
  857.  
  858. chain_address:    call get_A_field    ; LINK item 12
  859.         ld bc,(curr_mem)    ;
  860.         jp replace_loop        ;
  861.  
  862. def_cseg_size:    call get_A_field    ; LINK item 13
  863.         ld (size_cseg),hl    ;
  864.         ld de,(top_load)    ;
  865.         ld (start_cseg_real),de    ;
  866.         add hl,de        ;
  867.         ld (top_load),hl    ;
  868.         ld de,(top_of_mem)    ;
  869.         or a            ;
  870.         sbc hl,de        ;
  871.         jp nc,e_nomem        ;
  872.         ld hl,(start_cseg_real)    ;
  873.         ld bc,(curr_mem)    ;
  874.         ld a,b            ;
  875.         or c            ;
  876.         jr nz,already_defined    ;
  877.         ld (curr_mem),hl    ;
  878. already_defined:ld bc,(prog_buf)    ;
  879.         dec b            ;
  880.         or a            ;
  881.         sbc hl,bc        ; "NULL" abziehen
  882.         ld (start_cseg),hl    ;
  883.         jp load_gethl        ;
  884.  
  885. end_program:    call get_A_field    ; LINK item 14
  886.         ld a,0ffh        ; force Byte Boundary
  887.         ld (relcnt),a        ;
  888.         ld a,h            ;
  889.         or l            ;
  890.         ret z            ; done!
  891.         ex de,hl        ;
  892.         ld hl,(prog_buf)    ;
  893.         ld (hl),0c3h        ; JP
  894.         inc hl            ;
  895.         ld (hl),e        ;
  896.         inc hl            ;
  897.         ld (hl),d        ;
  898.         xor a            ; return 0: END OF MODULE
  899.         ret            ;
  900.  
  901. end_file:    ld a,1            ; LINK item 15
  902.         or a            ; return 1: END OF FILE
  903.         ret            ;
  904.  
  905. ;************************************************************************
  906. ;*                                    *
  907. ;*        Unterprogramm zum Einlesen einzelner Felder        *
  908. ;*                                    *
  909. ;************************************************************************
  910.  
  911. get_A_field:    ld a,2            ; to HL
  912.         call get_abits        ;
  913. read_16:    ld hl,base        ;
  914.         add hl,bc        ;
  915.         add hl,bc        ;
  916.         ld e,(hl)        ;
  917.         inc hl            ;
  918.         ld d,(hl)        ; DE = offset
  919.         push de            ;
  920.         call get_byte        ;
  921.         ld l,a            ;
  922.         call get_byte        ;
  923.         ld h,a            ;
  924.         pop de            ;
  925.         add hl,de        ; true address
  926.         ret            ;
  927.  
  928. get_B_field:    ld hl,B_field        ;
  929.         ld a,3            ;
  930.         call get_abits        ;
  931.         jr z,no_text        ;
  932.         ld (hl),a        ;
  933.         inc hl            ;
  934.         ld b,a            ;
  935. loop_get_B:    push bc            ;
  936.         call get_byte        ;
  937.         pop bc            ;
  938.         ld (hl),a        ;
  939.         inc hl            ;
  940.         djnz loop_get_B        ;
  941.         ld (hl),b        ; terminate with 0
  942.         ret            ;
  943.  
  944. no_text:    inc a            ; change empty to space!
  945.         ld (hl),a        ;
  946.         inc hl            ;
  947.         ld (hl),' '        ;
  948.         inc hl            ;
  949.         xor a            ;
  950.         ld (hl),a        ;
  951.         ret            ;
  952.  
  953. ;************************************************************************
  954. ;*                                    *
  955. ;*        REL-file I/O                        *
  956. ;*                                    *
  957. ;************************************************************************
  958.  
  959. get_byte:    ld a,8            ; HL saved, DE, BC not    A,C result
  960. get_abits:    ld c,0            ;            return B=0
  961.         ld b,a            ;
  962. loop:        call getbit        ;
  963.         rl c            ;
  964.         djnz loop        ;
  965.         ld a,c            ; NC, Z akkording to akku
  966.         ret            ;
  967.  
  968. getbit:        ld a,0            ; reg HL is saved, DE not
  969. relbyte        equ $-1            ; reg BC if read_sector saves it (ok)
  970.         ld d,0ffh        ;
  971. relcnt        equ $-1            ;
  972.         inc d            ;
  973.         jp nz,has_bit        ;
  974.         push hl            ;
  975.  
  976.         ld a,080h        ;
  977. bytecnt        equ $-1            ;
  978.         or a            ;
  979.         call m,read_sector    ; must return A=0 & D=0!!!
  980.         ld e,a            ;
  981.         inc a            ;
  982.         ld (bytecnt),a        ;
  983.         ld hl,read_buffer    ;
  984.         add hl,de        ;
  985.         ld a,(hl)        ;
  986.         ld d,0f8h        ;
  987.  
  988.         pop hl            ;
  989. has_bit:    add a,a            ;
  990.         ld (relbyte),a        ;
  991.         ld a,d            ;
  992.         ld (relcnt),a        ;
  993.         ret            ;
  994.  
  995.  
  996. read_sector:    push bc            ; BC saved
  997.         bdos set_dma_addr,read_buffer
  998.         bdos read_seq,rel_fcb    ;
  999.         pop bc            ;
  1000.         or a            ;
  1001.         ld d,a            ;
  1002.         ret z            ; hat geklappt
  1003.         ld hl,txt_unex_eof    ;
  1004.         jp rel_fehler        ;
  1005.  
  1006.         dseg            ;
  1007. rel_fcb:    db 0,'        REL'    ;
  1008.         ds 24h-12,0        ;
  1009. read_buffer:    ds 128,0        ;
  1010.         cseg            ;
  1011.  
  1012. ;************************************************************************
  1013. ;*                                    *
  1014. ;*        Error managing:                        *
  1015. ;*                                    *
  1016. ;************************************************************************
  1017.  
  1018. ;************************************************************************
  1019. ;*        I) non-FATAL errors                    *
  1020. ;************************************************************************
  1021.  
  1022. txt_special_4:    db 'Special Link-item (4) received at PC = 0x',0
  1023. txt_special4a:    db ': <',0
  1024. txt_special_8:    db 'Special Link-item (8) received',cr,lf,0
  1025.  
  1026. txt_2nd_larger:    db '**** Warning! 2nd COMMON larger: /',0
  1027. txt_2nd_2:    db '/ ****',cr,lf,0    ;
  1028.  
  1029. ;************************************************************************
  1030. ;*        II) FATAL errors                    *
  1031. ;************************************************************************
  1032.  
  1033. txt_no_mem:    db 'Not enough memory', 0;
  1034. txt_unex_eof:    db 'Unexpected EOF', 0
  1035. txt_no_addr:    db 'No loading address specified!', 0
  1036. saved_sp:    dw 0            ;
  1037. txt_undef_comm:    db 'Undefined COMMON selected: ',0
  1038.  
  1039. undefd_common:    ld hl,txt_undef_comm    ;
  1040. error_in_B:    call txtout        ;
  1041.         ld hl,B_field+1        ;
  1042.         jr rel_fehler        ;
  1043.  
  1044. e_no_addr:    ld hl,txt_no_addr    ;
  1045. rel_fehler:    call txtout        ;
  1046.         print <cr,lf,"Module ">    ;
  1047.         ld hl,program_name+1    ;
  1048.         call txtout        ;
  1049.         call crlf_out        ;
  1050.         ld sp,(saved_sp)    ;
  1051.         or 0ffh            ; return 0ffh on error
  1052.         ret            ;
  1053.  
  1054. ;************************************************************************
  1055. ;*                                    *
  1056. ;*        Ausgabe-Funktionen                    *
  1057. ;*                                    *
  1058. ;************************************************************************
  1059.  
  1060. txtout:        ld a,(hl)        ;
  1061.         or a            ;
  1062.         ret z            ;
  1063.         call akku_out        ;
  1064.         inc hl            ;
  1065.         jr txtout        ;
  1066.  
  1067. print_octal:    ex de,hl        ; shift HL
  1068.         ld bc,0106h        ; first digit has one bit only
  1069.         jr .octal2        ;
  1070.  
  1071. .octal1:    ld b,3            ;
  1072. .octal2:    xor a            ;
  1073. .octal3:    add hl,hl        ; shift bit
  1074.         rla            ; into akku
  1075.         djnz .octal3        ;
  1076.         add a,'0'        ; make it digit
  1077.         push bc            ; c is counter
  1078.         call akku_out        ;
  1079.         pop bc            ;
  1080.         dec c            ; another digit?
  1081.         jr nz,.octal1        ;
  1082.         ex de,hl        ;
  1083.         jr trailer        ;
  1084.  
  1085. hexout_de:    ld a,0            ; initially HEX
  1086. octal_flag    equ $-1            ;
  1087.         or a            ;
  1088.         jr nz,print_octal    ;
  1089.         ld a,d            ;
  1090.         call hexout_a        ;
  1091.         ld a,e            ;
  1092.         call hexout_a        ;
  1093. trailer:    ld a,'h'        ;
  1094. number_ext    equ $-1            ; initially 'h'
  1095.         jr akku_out        ;
  1096.  
  1097. hexout_a:    push af            ;
  1098.         rra            ;
  1099.         rra            ;
  1100.         rra            ;
  1101.         rra            ;
  1102.         call nib_out        ;
  1103.         pop af            ;
  1104. nib_out:    and 0fh            ;
  1105.         add a,'0'        ;
  1106.         cp '9'+1        ;
  1107.         jr c,akku_out        ;
  1108.         add a,7            ;
  1109. akku_out:    push de            ;
  1110.         push hl            ;
  1111.         ld e,a            ;
  1112.         bdos console_out    ;
  1113.         pop hl            ;
  1114.         pop de            ;
  1115.         ret            ;
  1116.  
  1117. crlf_out:    ld a,cr            ; HL, DE gerettet
  1118.         call akku_out        ;
  1119.         ld a,lf            ;
  1120.         jr akku_out        ;
  1121.  
  1122. tab_out:    ld a,tab        ; HL, DE gerettet
  1123.         jr akku_out        ;
  1124.  
  1125. ;******************************************************************************
  1126. ;*                                          *
  1127. ;*        Verwaltung der GLOBAL-Listen                      *
  1128. ;*                                          *
  1129. ;******************************************************************************
  1130.  
  1131. ;******************************************************************************
  1132. ;*                                          *
  1133. ;*    Format der Listen im Speicher:                          *
  1134. ;*                                          *
  1135. ;*    1) Globals/Undefineds:                              *
  1136. ;*       +-----------+------------+-------------+------------------------+  *
  1137. ;*       ! next (16) ! length (8) ! name (var.) ! USERvalue or list (16) !  *
  1138. ;*       +-----------+------------+-------------+------------------------+  *
  1139. ;*                                          *
  1140. ;*    2) COMMONs:                                  *
  1141. ;*       +-----------+------------+-------------+------------+-----------+  *
  1142. ;*       ! next (16) ! length (8) ! name (var.) ! Start (16) ! Size (16) !  *
  1143. ;*       +-----------+------------+-------------+------------+-----------+  *
  1144. ;*                                          *
  1145. ;*    3) REQUESTs                                  *
  1146. ;*       +-----------+------------+-------------+                  *
  1147. ;*       ! next (16) ! length (8) ! name (var.) !                  *
  1148. ;*       +-----------+------------+-------------+                  *
  1149. ;*                                          *
  1150. ;*    4) External + Offsets                              *
  1151. ;*       +-----------+--------------------+-------------+              *
  1152. ;*       ! next (16) ! REAL location (16) ! offset (16) !              *
  1153. ;*       +-----------+--------------------+-------------+              *
  1154. ;*                                          *
  1155. ;******************************************************************************
  1156.  
  1157. search_common:    ld hl,list_commons    ;
  1158.         jr search.1        ;
  1159. search_request:    ld hl,list_requests    ;
  1160.         jr search.1        ;
  1161. search_global:    ld hl,list_globals    ;
  1162.         jr search.1        ;
  1163.  
  1164. try_next.1:    pop hl            ;
  1165. search.1:    ld e,(hl)        ;
  1166.         inc hl            ;
  1167.         ld d,(hl)        ;
  1168.         ld a,d            ;
  1169.         or e            ;
  1170.         jr z,append_name.1    ;
  1171.         push de            ; address of new
  1172.         inc de            ;
  1173.         inc de            ;
  1174.         ld a,(de)        ; type of new
  1175.         ld c,a            ;
  1176.         and 0fh            ; length ausmaskieren
  1177.         ld hl,B_field        ;
  1178.         cp (hl)            ; length same?
  1179.         jr nz,try_next.1    ;
  1180.         ld b,a            ;
  1181.         inc de            ;
  1182. compare.1:    inc hl            ;
  1183.         ld a,(de)        ;
  1184.         sub (hl)        ;
  1185.         jr c,try_next.1        ;
  1186.         jr nz,insert_name.1    ;
  1187.         inc de            ;
  1188.         djnz compare.1        ;
  1189.         ex de,hl        ;
  1190.         ld e,(hl)        ;
  1191.         inc hl            ;
  1192.         ld d,(hl)        ;
  1193.         pop hl            ; HL = addr, DE = value
  1194.         ret            ; Z-Flag, A=00, B=00, C=type, HL=address,
  1195.                     ; DE=value
  1196. insert_name.1:    pop hl            ;
  1197.         db 3eh            ; ld a,..
  1198. append_name.1:    dec hl            ; zeigt auf &0
  1199.         or 0ffh            ;
  1200.         ret            ;
  1201.  
  1202. ;
  1203.  
  1204. get_end:    ld e,(hl)
  1205.         inc hl
  1206.         ld d,(hl)
  1207.         ld a,d
  1208.         or e
  1209.         ret z
  1210.         ex de,hl
  1211.         jr get_end
  1212.         
  1213. find_request:    call search_request    ;
  1214.         ret z            ;
  1215.         call get_end        ;
  1216.         dec hl            ;
  1217.         xor a            ;
  1218.         ld (offset),a        ;
  1219.         push hl            ; & new
  1220.         push de            ; 0
  1221.         jp append_name.2    ;
  1222. ;
  1223.  
  1224. find_global:    ld hl,list_globals    ;
  1225.         ld a,2            ;
  1226.         ld (offset),a        ;
  1227.         jr search.2        ;
  1228. find_common:    ld hl,list_commons    ;
  1229.         ld a,4            ;
  1230.         ld (offset),a        ;
  1231.         jr search.2        ;
  1232.  
  1233. try_next.2:    pop hl            ;
  1234.         pop de            ;
  1235. search.2:    push hl            ; address of old field
  1236.         ld e,(hl)        ;
  1237.         inc hl            ;
  1238.         ld d,(hl)        ;
  1239.         ld a,d            ;
  1240.         or e            ;
  1241.         push de            ; address of new
  1242.         jr z,append_name.2    ;
  1243.         inc de            ;
  1244.         inc de            ;
  1245.         ld a,(de)        ; type of new
  1246.         ld c,a            ;
  1247.         and 0fh            ; length ausmaskieren
  1248.         ld hl,B_field+1        ;
  1249.         ld b,a            ;
  1250.         inc de            ;
  1251. compare.2:    ld a,(de)        ;
  1252.         sub (hl)        ;
  1253.         jr c,try_next.2        ;
  1254.         jr nz,insert_name.2    ;
  1255.         inc hl            ;
  1256.         inc de            ;
  1257.         djnz compare.2        ;
  1258.         cp (hl)            ; Ende?
  1259.         jr nz,try_next.2    ; der in der Liste ist k}rzer
  1260.         ex de,hl        ;
  1261.         ld e,(hl)        ;
  1262.         inc hl            ;
  1263.         ld d,(hl)        ;
  1264.         pop hl            ;
  1265.         ex af,af'        ;
  1266.         pop af            ;
  1267.         ex af,af'        ;
  1268.         ret            ; Z-Flag, A=00, B=00, C=type, HL=address,
  1269.                     ; DE=value
  1270. insert_name.2:                ;
  1271. append_name.2:                ; ld a,(B_field)
  1272.                     ; add a,5        ; NC, I suppose
  1273.                     ; ld c,a
  1274.                     ; ld b,0
  1275.                     ; ld hl,(top_of_mem)
  1276.                     ; sbc hl,bc
  1277.                     ; ld (top_of_mem),hl
  1278.                     ; ex de,hl
  1279.                     ; ld hl,searchfield
  1280.                     ; ldir
  1281.         ld hl,B_field        ;
  1282.         ld a,(hl)        ;
  1283.         add a,2            ;
  1284. offset        equ $-1            ; weil COMMON 2 mehr braucht,
  1285.         ld c,a            ; REQUEST gar keinen
  1286.         ld b,0            ;
  1287.         add hl,bc        ;
  1288.         add a,3            ;
  1289.         ld c,a            ;
  1290.         ld de,(top_of_mem)    ;
  1291.         ld (later),de        ;
  1292.         lddr            ;
  1293.         ld (top_of_mem),de    ;
  1294.         ld hl,(top_load)    ;
  1295.         sbc hl,de        ; NC!!!
  1296.         jp nc,e_nomem        ;
  1297.         ex de,hl        ; HL := top of mem
  1298.         pop de            ; new (first too big)
  1299.         inc hl            ;
  1300.         ld (hl),e        ;
  1301.         inc hl            ;
  1302.         ld (hl),d        ; store pointer to next
  1303.         dec hl            ;
  1304.         ex de,hl        ; DE := pointer to new
  1305.         pop hl            ; HL := pointer to old
  1306.         ld (hl),e        ;
  1307.         inc hl            ;
  1308.         ld (hl),d        ; BC = 0
  1309.         or 0ffh            ; mark as new inserted
  1310.         ld hl,0            ; points to last byte of new entry
  1311. later        equ $-2            ; DE points to FIRST memory cell
  1312.         ret            ; HL points to LAST memory cell
  1313.                     ; of new element in list
  1314.  
  1315. ;************************************************************************
  1316. ;*        ENDE Speicherverwaltung                    *
  1317. ;************************************************************************
  1318.  
  1319. ;************************************************************************
  1320. ;*        ANFANG Ausgaberoutinen                    *
  1321. ;************************************************************************
  1322.  
  1323. print_name:    ld a,(hl)        ;
  1324.         and 0fh            ; nur L{nge nehmen
  1325.         ld e,a            ; Z{hler 1
  1326.         ld d,a            ; Z{hler 2
  1327. l001:        inc hl            ;
  1328.         ld a,(hl)        ;
  1329.         call akku_out        ;
  1330.         dec d            ;
  1331.         jr nz,l001        ;
  1332.         inc hl            ;
  1333.         call tab_out        ;
  1334.         ret            ;
  1335.  
  1336. print_mem_usage:print <cr,lf,"Memory usage:",cr,lf,"Program Start: ">
  1337.         ld de,103h        ;
  1338.         call hexout_de        ;
  1339.         print <cr,lf,"Program End:   ">
  1340.         ld hl,(top_load)    ;
  1341.         ld de,(prog_buf)    ;
  1342.         dec d            ;
  1343.         or a            ;
  1344.         sbc hl,de        ;
  1345.         ex de,hl        ;
  1346.         call hexout_de        ;
  1347.         ld hl,(prog_buf)    ;
  1348.         ld a,(hl)        ;
  1349.         or a            ;
  1350.         jr z,end_info        ;
  1351.         inc hl            ;
  1352.         ld e,(hl)        ;
  1353.         inc hl            ;
  1354.         ld d,(hl)        ;
  1355.         print <cr,lf,"Entry Point:   ">
  1356.         call hexout_de        ;
  1357. end_info:    jp crlf_out        ;
  1358.  
  1359. print_requests:    ld hl,list_requests    ;
  1360. rq_loop:    ld e,(hl)
  1361.         inc hl
  1362.         ld d,(hl)
  1363.         ld a,d
  1364.         or e
  1365.         ret z
  1366.         print "REQUEST "
  1367.         ex de,hl
  1368.         push hl
  1369.         inc hl
  1370.         inc hl
  1371.         call print_name
  1372.         call crlf_out
  1373.         pop hl
  1374.         jr rq_loop
  1375.  
  1376. print_commons:    ld hl,list_commons    ;
  1377.         ld e,(hl)        ;
  1378.         inc hl            ;
  1379.         ld d,(hl)        ;
  1380.         ld a,d            ;
  1381.         or e            ;
  1382.         ret z            ; no commons => auch keine Titelzeile
  1383.  
  1384.         print <cr,lf,"Common block name",tab,"Start",tab,"Size",cr,lf>
  1385.         ex de,hl        ;
  1386.  
  1387. pr_commons_loop:ld e,(hl)        ;
  1388.         inc hl            ;
  1389.         ld d,(hl)        ;
  1390.         push de            ; next (if exists)
  1391.         inc hl            ; zeigt jetzt auf L{nge des Namens
  1392.         call print_name        ;
  1393.         call tab_out        ;
  1394.         call tab_out        ;
  1395.  
  1396.         ld e,(hl)        ;
  1397.         inc hl            ;
  1398.         ld d,(hl)        ;
  1399.         call hexout_de        ;
  1400.         call tab_out        ;
  1401.  
  1402.         inc hl            ;
  1403.         ld e,(hl)        ;
  1404.         inc hl            ;
  1405.         ld d,(hl)        ;
  1406.         call hexout_de        ;
  1407.         call crlf_out        ;
  1408.         pop hl            ; n{chster COMMON
  1409.         ld a,h            ;
  1410.         or l            ;
  1411.         jr nz,pr_commons_loop    ;
  1412.         ret            ;
  1413.  
  1414. text_globals:    db cr,lf,'Defined Globals:',0
  1415. text_undefineds:db cr,lf,'Undefined Globals:',0;
  1416.  
  1417. advance:    ld a,0            ;
  1418. spalten_counter    equ $-1            ;
  1419.         or a            ;
  1420.         jr nz,not_first        ;
  1421.         push hl            ;
  1422.         ld hl,0            ;
  1423. text_1        equ $-2            ;
  1424.         call txtout        ;
  1425.         pop hl            ;
  1426.         ld a,1            ;
  1427. not_first:    dec a            ;
  1428.         jr nz,tab_only        ;
  1429.         call crlf_out        ;
  1430.         ld a,3            ;
  1431.         ld (spalten_counter),a    ;
  1432.         ret            ;
  1433.  
  1434. tab_only:    ld (spalten_counter),a    ;
  1435.         jp tab_out        ;
  1436.  
  1437. print_undefds:    ld hl,text_undefineds    ;
  1438.         ld a,80h        ;
  1439.         jr intro.1        ;
  1440. print_globals:    ld hl,text_globals    ;
  1441.         xor a            ;
  1442. intro.1:    ld (text_1),hl        ;
  1443.         ld (modebyte),a        ;
  1444.         ld hl,(list_globals)    ;
  1445.         xor a            ;
  1446.         ld (spalten_counter),a    ;
  1447.         ex de,hl        ;
  1448.  
  1449. next_global:    ex de,hl        ;
  1450.         ld a,h            ;
  1451.         or l            ;
  1452.         jr z,ende_globals    ;
  1453.         ld e,(hl)        ;
  1454.         inc hl            ;
  1455.         ld d,(hl)        ;
  1456.         inc hl            ;
  1457.         ld a,(hl)        ;
  1458.         xor 0            ;
  1459. modebyte    equ $-1            ;
  1460.         jp m,next_global    ; weil falscher Typ
  1461.         push de            ; next Global
  1462.         call advance        ;
  1463.         call print_name        ;
  1464.         ld e,(hl)        ;
  1465.         inc hl            ;
  1466.         ld d,(hl)        ;
  1467.         call hexout_de        ;
  1468.         pop de            ;
  1469.         jr next_global        ;
  1470.  
  1471. ende_globals:    call crlf_out        ;
  1472.         ret            ;
  1473.  
  1474. list_defineds:    ld (txt_ptr),hl        ;
  1475.         call print_mem_usage    ;
  1476.         call print_commons    ;
  1477.         call print_globals    ;
  1478. .intro:        call print_undefds    ;
  1479.         call print_requests    ;
  1480.         call crlf_out        ;
  1481.         jp main_loop        ;
  1482.  
  1483. list_undefineds:ld (txt_ptr),hl        ;
  1484.         call print_mem_usage    ;
  1485.         jr .intro        ;
  1486.  
  1487. name_outfile:    ld (txt_ptr),hl        ;
  1488.         ld hl,user_fcb        ;
  1489.         ld de,out_fcb        ;
  1490.         ld bc,24h        ;
  1491.         ldir            ;
  1492.         ld hl,out_fcb+9        ;
  1493.         ld a,(hl)        ;
  1494.         or a            ; Extent given?
  1495.         jr nz,has_out_ext    ;
  1496.         ld (hl),'C'        ;
  1497.         inc hl            ;
  1498.         ld (hl),'O'        ;
  1499.         inc hl            ;
  1500.         ld (hl),'M'        ;
  1501.  
  1502. has_out_ext:    jp main_loop        ;
  1503.  
  1504.         dseg            ;
  1505. out_fcb:    db 0,'           '    ;
  1506.         ds 24h-12,0        ;
  1507.         cseg            ;
  1508.  
  1509. save_object:    ld a,(out_fcb+1)    ;
  1510.         cp ' '            ;
  1511.         jr z,no_name_err    ;
  1512.         call satisfy_request    ; any requests?
  1513.         call set_offsets    ;
  1514.         call set_$memry        ;
  1515.         call print_undefds    ;
  1516.         call print_mem_usage    ;
  1517.  
  1518. write_file:    bdos delete_file,out_fcb;
  1519.         bdos make_file,out_fcb    ;
  1520.         cp 4            ;
  1521.         jr nc,creation_err    ;
  1522.         ld de,(prog_buf)    ;
  1523. write_loop:    push de            ;
  1524.         bdos set_dma_addr    ;
  1525.         bdos write_seq,out_fcb    ;
  1526.         or a            ;
  1527.         jr nz,write_err        ;
  1528.         pop de            ;
  1529.         ld hl,80h        ;
  1530.         add hl,de        ;
  1531.         ex de,hl        ;
  1532.         ld hl,(top_load)    ;
  1533.         scf            ;
  1534.         sbc hl,de        ;
  1535.         jr nc,write_loop    ;
  1536.         bdos close_file,out_fcb    ;
  1537.         jp 0            ;
  1538. write_err:    print <"Disk full",cr,lf>
  1539.         jp abbruch        ;
  1540. creation_err:    print <"Can't create object file",cr,lf>
  1541.         jp abbruch        ;
  1542. no_name_err:    print <"No filename to save.",cr,lf,"Exiting without saving.",cr,lf>
  1543.         jp 0            ;
  1544.  
  1545. set_offsets:    ld hl,(list_explus)    ;
  1546.  
  1547. set_offsets_loop:ld a,h            ;
  1548.         or l            ;
  1549.         ret z            ; Ende der Liste
  1550.         ld e,(hl)        ;
  1551.         inc hl            ;
  1552.         ld d,(hl)        ;
  1553.         inc hl            ;
  1554.         push de            ;
  1555.  
  1556.         ld e,(hl)        ;
  1557.         inc hl            ;
  1558.         ld d,(hl)        ; DE := REAL address
  1559.         inc hl            ;
  1560.         ld a,(de)        ;
  1561.         add a,(hl)        ; correct lowbyte
  1562.         ld (de),a        ;
  1563.         inc hl            ;
  1564.         inc de            ;
  1565.         ld a,(de)        ;
  1566.         adc a,(hl)        ; correct highbyte
  1567.         ld (de),a        ;
  1568.  
  1569.         pop hl            ;
  1570.         jr set_offsets_loop    ;
  1571.  
  1572.         dseg            ;
  1573. memry_global:    db 6,'$MEMRY',0        ;
  1574.         cseg            ;
  1575.  
  1576. set_$memry:    ld hl,memry_global    ;
  1577.         ld de,B_field        ;
  1578.         ld bc,8            ;
  1579.         ldir            ;
  1580.         call search_global    ;
  1581.         ret nz            ; not found
  1582.         inc hl            ;
  1583.         inc hl            ;
  1584.         bit 7,(hl)        ; undefined?
  1585.         ret nz            ;
  1586.         ld bc,(prog_buf)    ;
  1587.         dec b            ; BC := REAL(0000h)
  1588.         ld hl,(top_load)    ;
  1589.         or a            ;
  1590.         sbc hl,bc        ; minus NULL = USER top_load
  1591.         ex de,hl        ; HL := USER address
  1592.         add hl,bc        ; HL := REAL address
  1593.         ld (hl),e        ;
  1594.         inc hl            ;
  1595.         ld (hl),d        ;
  1596.         ret            ;
  1597.  
  1598. search_library:    ld (txt_ptr),hl        ;
  1599.         call search_lib        ;
  1600.         jp main_loop        ;
  1601.  
  1602. search_lib:    call open_relfile    ;
  1603.  
  1604. check_module:    ld a,(bytecnt)        ; save position in file
  1605.         ld de,save_fcb        ;
  1606.         ld hl,rel_fcb        ;
  1607.         ld bc,24h+80h        ;
  1608.         ldir            ;
  1609.         ld (de),a        ;
  1610.         ld a,0ffh        ;
  1611.         ld (relcnt),a        ; setze auf Byte-Grenze
  1612. skip_loop:    call getbit        ;
  1613.         jr nc,skip_8        ;
  1614.         ld a,2            ;
  1615.         call get_abits        ;
  1616.         jr nz,skip_16        ;
  1617.         ld a,4            ;
  1618.         call get_abits        ;
  1619.         cp 15            ; End of file?
  1620.         ret z            ;
  1621.         push af            ; type
  1622.         sub 5            ; 5 - 14 hat A-field
  1623.         cp 10            ;
  1624.         call c,get_A_field    ;
  1625.         pop af            ;
  1626.         push af            ;
  1627.         cp 9            ;
  1628.         call c,get_B_field    ;
  1629.         pop af            ;
  1630.         cp 14            ; end of module?
  1631.         jr z,check_module    ; (the next one)
  1632.         or a            ; Entry symbol?
  1633.         jr nz,skip_loop        ;
  1634.         call search_global    ;
  1635.         jr nz,skip_loop        ; Name nicht bekannt
  1636.         inc hl            ;
  1637.         inc hl            ;
  1638.         bit 7,(hl)        ; defined?
  1639.         jr z,skip_loop        ; yes!
  1640.         jr load_this        ;
  1641. skip_16:    ld a,8            ;
  1642.         call get_abits        ;
  1643. skip_8:        ld a,8            ;
  1644.         call get_abits        ;
  1645.         jr skip_loop        ;
  1646.  
  1647. load_this:    ld hl,save_fcb        ; restore old position in FCB
  1648.         ld de,rel_fcb        ;
  1649.         ld bc,24h+80h        ;
  1650.         ldir            ;
  1651.         ld a,(hl)        ; bytecnt
  1652.         ld (bytecnt),a        ;
  1653.         call load_module    ;
  1654.         or a            ;
  1655.         jp nz,abbruch        ;
  1656.         jr check_module        ;
  1657.  
  1658.         dseg            ;
  1659. save_fcb:    ds 25h+080h,0        ; and save Buffer
  1660.         cseg            ;
  1661.  
  1662. satisfy_request:ld hl,(list_requests)    ;
  1663.         ld a,l
  1664.         or h            ; no request?
  1665.         ret z
  1666.         ld hl,(list_globals)    ;
  1667. try_if_undef:    ld a,l
  1668.         or h
  1669.         ret z            ; no undefined global found, don't search
  1670.         ld e,(hl)
  1671.         inc hl
  1672.         ld d,(hl)
  1673.         inc hl
  1674.         bit 7,(hl)
  1675.         ex de,hl
  1676.         jr z,try_if_undef    ; dieser ist definiert
  1677.  
  1678.         print "Searching "
  1679.         ld hl,blank_fcb        ; found undefined global
  1680.         ld de,user_fcb
  1681.         ld bc,24h
  1682.         ldir
  1683.         ld hl,(list_requests)    ;
  1684.         ld e,(hl)
  1685.         inc hl
  1686.         ld d,(hl)
  1687.         ld (list_requests),de    ; next request
  1688.         inc hl
  1689.         push hl
  1690.         ld c,(hl)
  1691.         inc hl
  1692.         ld de,user_fcb+1
  1693.         ldir
  1694.         pop hl
  1695.         call print_name
  1696.         call crlf_out
  1697.         call search_lib
  1698.         jr satisfy_request
  1699.         end entry        ;
  1700.