;*********************************************************************
;*   MLIMAGE1.ASM                                                    *
;*                                                                   *
;*   By:            Michael Devore                                   *
;*   Date:          12/30/92                                         *
;*   Model:         Small                                            *
;*   Version:       2.5                                              *
;*   Assembler:     MASM 5.0                                         *
;*   Environment:   MS-DOS 2.x+                                      *
;*                                                                   *
;*   memory image routines, part 1                                   *
;*                                                                   *
;*********************************************************************

;TITLE   WARPLINK mlimage1
;PAGE    50,80

;.MODEL  SMALL

;*****************************
;* Include files             *
;*****************************

[list -]
%include "lmacros3.mac"
[list -]
%include "mlequate.mac"
%include "mldata.mac"
%include "mlerrmes.mac"
[list +]
     
;*****************************
;* Public declarations       *
;*****************************

; procedures
PUBLIC  setup_exe_image,write_program,write_bytes,caseless_strcmp
PUBLIC	compute_seg_frames
public	check_com_cut

; variables
PUBLIC  exe_handle,segment_start,segment_stop,true_seg_len

;*****************************
;* Data begins               *
;*****************************

.DATA

;*****************************
;* External declarations     *
;*****************************

 extern align_ax_from_bl
EXTRN   data_segment:WORD,data_offset:DWORD,filename:BYTE
EXTRN   is_emsxms_ovl:BYTE
EXTRN	filesize_text:BYTE
EXTRN	first_clipmod_ptr:WORD,is_summer87:BYTE,is_clipper5:BYTE
extern	skip_length

; initialized local variables

; byte values
EVEN                        ; maximize speed on 8086 and better
stack_found DB  0           ; nonzero if stack segment encountered
EVEN
phase   DB  0               ; DOSSEG segment ordering phase
EVEN
com_end_flag    DB  0       ;  1 if $$_COM_END variable allocated, 2 if not used
EVEN

res_incflag DB  0           ; 1 if Clipper incremental link and current class 'CODE'
                            ; 2 if class 'SYMBOLS'
EVEN
_wlcalc_pass:		dw 0
_wlcalc_maximum_pass:	dw 0

EVEN
; doubleword values
segment_start   DD  0       ; start of segments

; structures
EXE_HEADER_STRUC    STRUC
    eh_sig1 DB  ?           ; EXE file signature bytes
    eh_sig2 DB  ?
    eh_flen DW  ?           ; length of file module 512 */
    eh_fsize    DW  ?       ; size of file in 512-byte pages, including header
    eh_numrel   DW  ?       ; number of relocation items
    eh_hsize    DW  ?       ; size of header in paragraphs
    eh_minalloc DW  ?       ; minimum number of paragraphs needed above program
    eh_maxalloc DW  ?       ; maximum number of paragraphs needed above program
    eh_ss   DW  ?           ; SS at entry
    eh_sp   DW  ?           ; SP at entry
    eh_chksum   DW  ?       ; word checksum (unused
    eh_ip   DW  ?           ; contents of IP register at entry
    eh_cs   DW  ?           ; CS at entry
    eh_roff DW  ?           ; offset of first relocation item in file
    eh_ovnum    DB  ?       ; overlay number
    eh_filler   DB  3 DUP (?)   ; not used
EXE_HEADER_STRUC    ENDS

exe_header:
istruc EXE_HEADER_STRUC
at eh_sig1
exe_header.eh_sig1:	db 4dh
at eh_sig2
exe_header.eh_sig2:	db 5ah
at eh_flen
exe_header.eh_flen:
at eh_fsize
exe_header.eh_fsize:
at eh_numrel
exe_header.eh_numrel:
at eh_hsize
 global exe_header.eh_hsize
exe_header.eh_hsize:
at eh_minalloc
exe_header.eh_minalloc:
at eh_maxalloc
exe_header.eh_maxalloc:	dw 0ffffh
at eh_ss
exe_header.eh_ss:
at eh_sp
exe_header.eh_sp:
at eh_chksum
exe_header.eh_chksum:	dw 0
at eh_ip
exe_header.eh_ip:
at eh_cs
exe_header.eh_cs:
at eh_roff
exe_header.eh_roff:	dw 30
at eh_ovnum
exe_header.eh_ovnum:	db 0
at eh_filler
exe_header.eh_filler:
iend

EVEN
_wlcalc_do_table:
	dw string_div, _wlcalc_do_div
	dw string_mul, _wlcalc_do_mul
	dw string_shr, _wlcalc_do_shr
	dw string_shl, _wlcalc_do_shl
	dw string_xor, _wlcalc_do_xor
	dw string_or, _wlcalc_do_or
	dw string_and, _wlcalc_do_and
	dw string_clr, _wlcalc_do_clr
	dw string_add, _wlcalc_do_add
	dw string_subr, _wlcalc_do_subr	; must be before SUB
	dw string_sub, _wlcalc_do_sub
	dw string_itoa, _wlcalc_do_itoa
	dw string_minussegrel, _wlcalc_do_minussegrel
	dw string_segrel, _wlcalc_do_segrel	; must be before SEG
	dw string_seg, _wlcalc_do_seg
	dw string_wrt, _wlcalc_do_wrt
.ext:
	dw string_opext, _wlcalc_do_opext
	dw string_minusextpara, _wlcalc_do_minusextpara	; must be before MINUSEXT
	dw string_extpara, _wlcalc_do_extpara	; must be before EXT
	dw string_minusext, _wlcalc_do_minusext
	dw string_ext, _wlcalc_do_ext
	dw 0

_wlcalc_size_table:
	dw string_byte, 1
	dw string_word, 2
	dw string_3byte, 3
	dw string_dword, 4
	dw 0

.DATA?

; uninitialized local variables

; byte values
EVEN
res_occurred    DB  ?       ; nonzero flags a segment resolved in resolution pass
EVEN
using_class DB  ?           ; nonzero if resolving segments for a class, zero if no class selected yet
EVEN
_wlcalc_create_relocations:	db ?

EVEN

; word values
_wlcalc_obj_index:	dw ?
_wlcalc_pubdef:		dw ?
_wlcalc_wrt_pointer:	dd ?
_wlcalc_offset:	dw ?
_wlcalc_segment:	dw ?
unresolved_segs DW  ?       ; count of segments still have their addresses resolved
segdef_block_ptr    DW  ?   ; current pointer to segdef block
entry_number    DW  ?       ; current entry in segdef block
exe_handle  DW  ?           ; handle of executable file
com_end_pubptr  DW  ?       ; pointer to $$_COM_END public declaration entry
temp_buffer_size    DW  ?   ; size of temporary buffer
temp_buffer_base    DW  ?   ; segment pointer to start of temporary buffer
class_group DW  ?           ; group entry segment of class-setting segment, only used by DOSSEG

; doubleword values
true_seg_len    DD  ?       ; true segment length (can be 10000h from Big bit)
segment_stop    DD  ?       ; segment stop address

; byte strings
symname_buffer	LABEL	BYTE
class_name_field    DB  128 DUP (?) ; class name of segdef entry
group_name_field    DB  128 DUP (?) ; group name of segdef entry

;*****************************
;* Constant data             *
;*****************************

.CONST

; constant strings in DOSSEG segment class type computation
EVEN
codetext    DB  'CODE',0
EVEN
begdatatext DB  'BEGDATA',0
EVEN
bsstext     DB  'BSS',0
EVEN
stacktext   DB  'STACK',0
EVEN
com_end_text    DB  '$$_COM_END',0

maxalloc_len    DW  maxalloc_stop-maxalloc_warn
maxalloc_warn   DB  CR,LF,'Maximum program allocation space less than minimum required, maximum adjusted.'
maxalloc_stop   equ   $

string_wlcalc:	asciz "WLCALC"
string_div:	asciz "DIV"
string_mul:	asciz "MUL"
string_shr:	asciz "SHR"
string_shl:	asciz "SHL"
string_xor:	asciz "XOR"
string_or:	asciz "OR"
string_and:	asciz "AND"
string_clr:	asciz "CLR"
string_add:	asciz "ADD"
string_sub:	asciz "SUB"
string_subr:	asciz "SUBR"
string_seg:	asciz "SEG"
string_minussegrel:
		db "MINUS"
string_segrel:	asciz "SEGREL"
string_minusext:
		db "MINUS"
string_ext:	asciz "EXT"
string_minusextpara:
		db "MINUS"
string_extpara:	asciz "EXTPARA"
string_opext:	asciz "OPEXT"
string_itoa:	asciz "ITOA"
string_wrt:	asciz "WRT"
string_repeat:	asciz "REPEAT"
string_pass:	asciz "PASS"
string_3byte:	db "3"
string_byte:	asciz "BYTE"
string_dword:	db "D"
string_word:	asciz "WORD"

string_invalid_filename:
.:		asciz "(Invalid filename)"
.size equ $ - .
string_unknown_filename:
.:		asciz "(Unknown filename)"
.size equ $ - .

;*****************************
;* Code begins               *
;*****************************

.CODE

;*****************************
;* External declarations     *
;*****************************

; procedures
EXTRN   link_error:NEAR,dos_error:NEAR,alloc_memory:NEAR
EXTRN   get_memory:NEAR,free_memory:NEAR,link_warning:NEAR
EXTRN   zero_mem_image:NEAR,update_temp_file:NEAR,create_temp_file:NEAR
EXTRN   temp_file_write:NEAR,dump_temp_file:NEAR
EXTRN   map_segments:NEAR,map_groups:NEAR,error_read_buff_pos:NEAR
EXTRN   get_pubdecl_entry:NEAR,add_pubdef_name:NEAR,find_pubdecl_entry:NEAR
EXTRN   resolve_ovl_info:NEAR,write_vectors:NEAR,flush_ovl_page:NEAR
EXTRN   ovl_file_write:NEAR,flush_reloc_array:NEAR
EXTRN   res_ilfseg:NEAR,ilf_rewind:NEAR,write_clar_data:NEAR
EXTRN   make_master_segblk:NEAR
EXTRN   map_ems_page:NEAR,ems_ovl_to_file:NEAR,restore_ems_map:NEAR
EXTRN	get_symbol_offset:NEAR,read_to_ems:NEAR

;*****************************
;* SETUP_EXE_IMAGE           *
;*****************************

; compute segment frame values and allocate disk or memory space for the
; executable image of the program
; destroys all registers except ds

setup_exe_image PROC
    xor ax,ax
    mov [ovl_data_id],ax      ; zero overlaid data flag

    call    get_memory      ; allocate memory for warplink use

    cmp byte [is_comfile],0        ; see if is a com file
    jne sei_iscom           ; yes

sei_no_com_end:
    mov byte [com_end_flag],2      ; flag that $$_COM_END variable is not used
    jmp SHORT sei_1         ; bypass $$_COM_END variable check

; com file, check if $$_COM_END was previously declared
sei_iscom:
    mov di,OFFSET com_end_text wrt DGROUP   ; ds:di -> declaration name
    mov al,1                ; attempt public declaration
    call    get_pubdecl_entry   ; make or find previous public declaration entry
    or  ax,ax               ; see if segment is null
    je  sei_no_com_end      ; yes, previous $$_COM_END definition
    mov [com_end_pubptr],ax   ; save -> entry
    mov es,ax               ; es -> $$_COM_END declaration entry
    cmp BYTE PTR [es:14],0  ; see if this was the first ever use of $$_COM_END
    je  sei_no_com_end      ; yes, not used as an external anywhere, don't bother creating it
    mov BYTE PTR [es:14],2  ; flag as public declaration
    mov di,OFFSET com_end_text wrt DGROUP   ; ds:di -> declaration name
    call    add_pubdef_name ; save public name
    mov [es:4],ax           ; save offset pointer to name in pubdef names block
    mov [es:6],dx           ; save segment pointer to name in pubdef names block

sei_1:
    cmp word [ovl_count],0         ; see if any overlays
    je  sei_1a              ; no
    call    make_master_segblk  ; create block holding entries for all master segdefs of overlaid segparts
    call    resolve_ovl_info    ; resolve all overlay information, create overlay file

sei_1a:
    call    compute_seg_frames

sei_1b:
    call    free_memory     ; de-allocate unused memory
	mov ax, word [true_seg_len]	; last segment is empty ?
	or ax, word [true_seg_len + 2]	; set ZF
    mov ax,WORD PTR [segment_stop]    ; get final segment stop low word
    mov bx,WORD PTR [segment_stop+2]  ; get final segment stop high word
	jz @F				; yes last segment is empty -->
    add ax,1                ; add one to value to get total program size
    adc bx,0                ; adjust high word
@@:
    mov WORD PTR [image_size],ax  ; save low word of size
    mov WORD PTR [image_size+2],bx    ; save high word of size

    mov ah,48h              ; allocate memory
    mov bx,0ffffh           ; force request to fail, function will return largest available block
    int 21h
    cmp ax,8                ; insufficient memory error is expected
    je sei_2

sei_todos_err:
    jmp NEAR PTR dos_error  ; other errors are fatal

sei_2:
    cmp bx,500h             ; block size must be >=20K (500h paragraphs)
    jbe sei_todos_err       ; not enough memory for building executable, ax holds insufficent memory error value

    mov ax,bx
    sub ax,400h             ; must leave at least 16K for i/o buffers and remaining tables
    xor dx,dx               ; dx:ax will hold bytes of of space available
	mov cx, 4
@@:
    shl ax,1                ; convert paragraphs available in ax into bytes in dx:ax
    rcl dx,1                ; x2
	loop @B			; x16, paragraph converted to bytes
    cmp dx,WORD PTR [image_size+2]    ; compare high word of space available to image size
	jne @F
    cmp ax,WORD PTR [image_size]  ; compare low word of space available to image size
@@:
    jae sei_inmemory        ; enough available space to place image in memory
				; too little space to build executable in memory
sei_ondisk:
    mov BYTE [is_ondisk],1    ; flag that image is on disk
    call    create_temp_file    ; create temporary file for executable image
    jmp SHORT sei_4         ; bypass memory image code

sei_inmemory:
	rol byte [is_temp_forced], 1
	jc sei_ondisk
    mov BYTE [is_inmem],1     ; flag that image is in memory
    mov bx,WORD PTR [image_size]  ; get low word of image size
    add bx,15               ; round up for paragraph computation
    mov dx,WORD PTR [image_size+2]    ; get high word of image size
    adc dx,0                ; carry to high word

; convert image size in dx:bx to paragraphs
	mov cx, 4
@@:
    shr dx,1
    rcr bx,1                ; /2
    loop @B			; 4 times / 2 = / 16
				; dx should be zero by the final shift

    mov ah,48h              ; allocate memory
    int 21h
    jnc sei_3               ; no errors
    jmp NEAR PTR dos_error  ; any error is fatal

sei_3:
    mov [image_mem_ptr],ax    ; save pointer to memory image
    mov bx,WORD PTR [image_size]  ; get low word of image size to zero
    mov dx,WORD PTR [image_size+2]    ; get high word of image size to zero
    call    zero_mem_image  ; fill memory image with zeros

sei_4:
    cmp word [ovl_count],0         ; see if any overlays
    je  sei_5               ; no
    call    get_memory      ; allocate memory for warplink use
    call    write_vectors   ; write vector values to overlay class segments
    call    free_memory     ; de-allocate unused memory

;if $$_COM_END variable exists, put program size at its location
sei_5:
    cmp byte [com_end_flag],1      ; see if $$_COM_END variable declared
    jne sei_ret             ; no

    mov ax,[com_end_pubptr]
    mov es,ax               ; es -> $$_COM_END public declaration entry
    mov ax,[es:8]           ; get public offset
    mov WORD PTR [data_offset],ax ; store in data_offset variable for write_bytes procedure
    xor ax,ax
    mov WORD PTR [data_offset+2],ax   ; zero high word of data_offset
    mov ax,[es:0]           ; get pointer to segment partition entry
    mov es,ax               ; es -> segment partition entry
    mov es,[es:4]           ; es -> master segdef entry of $$_COM_END variable
    mov ax,[es:2]           ; get segment offset
    add WORD PTR [data_offset],ax ; add in segment offset to data_offset
    mov si,OFFSET image_size wrt DGROUP ; get image size
	push	ds
	pop	es					; es:si -> image_size byte values
    mov cx,2                ; write two bytes
    call    write_bytes     ; write 'em

sei_ret:
    ret
setup_exe_image ENDP

;*****************************
;* COMPUTE_SEG_FRAMES        *
;*****************************

; compute segment frame values
; destroys all registers except ds

compute_seg_frames  PROC
    mov ax,[seg_count]
    mov [unresolved_segs],ax  ; init count of unresolved address segments

    cmp byte [is_anyovls],0        ; see if any overlaid modules specified
	jne	csf_res3			; yes

csf_1:
    mov byte [res_occurred],1      ; init flag on to avoid error message

csf_resloop:
    cmp word [unresolved_segs],0   ; check if all segments have been resolved
    jne csf_2               ; not yet
    jmp NEAR PTR csf_res_done   ; yes, all segment addresses resolved

csf_2:
    cmp byte [res_occurred],0      ; see if segment resolved this pass
    jne csf_res3            ; yes
    cmp byte [is_dosseg],0         ; see if dosseg switch set
    jne csf_res2            ; yes

; no segment resolved last pass and not using DOSSEG segment ordering, internal error
csf_internal:
    mov ax,INTERNAL_ERR     ; put warplink error code in ax
    mov cx,1                ; internal error value
    jmp NEAR PTR link_error ; transfer control to error handler

csf_res2:
    inc byte [phase]               ; bump phase of segment ordering
    cmp byte [phase],6             ; see if phase out of bounds
    jae csf_internal        ; yes, out of bounds

csf_res3:
    xor ax,ax
    mov [entry_number],ax     ; init entry number

csf_res4:
    mov ax,[first_segdefblk_ptr]
    mov [segdef_block_ptr],ax ; init current pointer to segdef block
    xor al,al
    mov [res_occurred],al     ; reset segment resolution flag
    mov [using_class],al      ; init using class name flag

csf_segblk_loop:
    mov ax,[segdef_block_ptr]
    or  ax,ax               ; check if any more segdef entries
    je  csf_resloop         ; no, move to next segment
    mov es,ax               ; es -> segdef entry

    mov ax,[entry_number]     ; get current entry number
    cmp ax,SEG_DEFENT_COUNT ; check if any room for more entries in block
    jb  csf_3               ; yes
    mov ax,[es:2]           ; point to next block
    mov [segdef_block_ptr],ax ; save back to memory variable
    xor ax,ax
    mov [entry_number],ax     ; reinit entry number
    jmp SHORT csf_segblk_loop  ; loop back for next block entry

csf_3:
    cmp ax,[es:0]           ; see if any more entries in block
    jae csf_resloop         ; no, break out to main segment resolution loop

; get an entry from the current block
csf_4:
    mov bx,[entry_number]     ; get entry number
    shl bx,1                ; each entry takes up two paragraphs
    mov ax,es               ; get block segment address
    add bx,ax               ; get entry's segment value
    inc bx                  ; adjust for block system info size of 1 paragraph
    mov es,bx               ; es -> segdef entry

    cmp BYTE PTR [es:27],0  ; check segment resolution flag
    je  csf_5               ; segment not yet resolved
    inc word [entry_number]        ; bump to next segdef entry
    jmp SHORT csf_segblk_loop     ; loop back to check next segdef entry

csf_5:
    mov di,OFFSET class_name_field wrt DGROUP
    mov si,[es:12]          ; get segdef entry class name offset into lnames block
    add si,8                ; adjust past two doubleword pointers at beginning of lnames entry
    mov bx,[es:14]          ; get segdef entry class name segment into lnames block

    mov dx,ds               ; save data segment
    mov ds,bx               ; ds:si -> segdef entry class name
    mov bx,es               ; save pointer to segdef entry
    mov es,dx               ; es:di -> WarpLink data class name field

    cmp byte [es:using_class],0    ; check if class selected yet
    je  csf_noclass         ; no
    jmp NEAR PTR csf_6      ; yes

; no class selected yet
csf_noclass:
    cmp byte [es:com_end_flag],0   ; see $$_COM_END variable used and not allocated yet
    jne csf_5a              ; no
    call    get_class_type  ; get class type, returned in al
    or  al,al               ; see if class CODE
    jne csf_5a              ; no

; allocate room for $$_COM_END variable at end of segment
    mov byte [es:com_end_flag],1   ; yes, set com_end_flag
    push    ds              ; save critical register
    mov ds,bx               ; ds -> segdef entry
    mov cx,[6]           ; get previous segment length

;*** check for segment length overflow after 2-byte addition?

    add WORD PTR [6],2   ; adjust length by two bytes for $$_COM_END variable
    mov ax,[22]          ; get pointer to first segment partition entry
    mov ds,[es:com_end_pubptr]    ; ds -> $$_COM_END declaration entry
    mov [0],ax           ; update segment pointer to segdef partition entry
    mov [8],cx           ; offset of variable is previous end of segment
    pop ds                  ; restore critical register

csf_5a:
    cmp byte [es:is_dosseg],0      ; see if DOSSEG segment ordering in force
    je  csf_clname_loop     ; no

; generate proper DOSSEG segment ordering
    call    get_class_type  ; get class type, returned in al
    cmp al,[es:phase]         ; see if phase matches type
    jne to_csf_restore      ; no
    cmp al,4                ; see if class BSS
    jne csf_not_bss         ; no
    cmp word [es:_edata_segaddr],0 ; see if beginning BSS address set yet
    jne csf_clname_loop     ; yes
    mov [es:_edata_segaddr],bx    ; keep segdef entry segment pointer to BSS
    jmp SHORT csf_clname_loop

to_csf_restore:
    jmp NEAR PTR csf_restore

csf_not_bss:
    cmp al,5                ; see if class STACK
    jne csf_clname_loop     ; no
    cmp word [es:_end_segaddr],0   ; see if beginning STACK address set yet
    jne csf_clname_loop     ; yes
    mov [es:_end_segaddr],bx  ; keep segdef entry segment pointer to BSS

; select a class, use entry class name
csf_clname_loop:
    movsb                   ; transfer a char from entry class name to current class name
    cmp BYTE PTR [si-1],0   ; zero byte signals end of transfer
    jne csf_clname_loop     ; nonzero, keep looping
    mov byte [es:using_class],1    ; flag that a class is in use

    cmp byte [es:is_clpinc],0      ; see if Clipper incremental link in process
    je  csf_5b              ; no
    cmp word [si-5], "CO"
    jne csf_chksym          ; not class 'CODE'
    cmp word [si-3], "DE"
    jne csf_chksym          ; not class 'CODE'
    mov byte [es:res_incflag],1    ; set incremental link segment resolution flag for CODE
    jmp SHORT csf_5c

; check if class 'SYMBOLS'
csf_chksym:
    cmp word [si-8], "SY"
    jne csf_5b              ; not class 'SYMBOLS'
    cmp word [si-6], "MB"
    jne csf_5b
    cmp word [si-4], "OL"
    jne csf_5b
    cmp BYTE PTR [si-2],'S'
    jne csf_5b
    mov byte [es:res_incflag],2    ; set incremental link segment resolution flag for SYMBOLS
    jmp SHORT csf_5c

; not proper class
csf_5b:
    mov byte [es:res_incflag],0    ; zero incremental link segment resolution flag

csf_5c:
    mov dx,es               ; save es -> WarpLink data
    mov es,bx               ; es -> segdef entry
    mov ax,[es:16]          ; get group entry segment, if any
    mov es,dx               ; es -> WarpLink data
    mov [es:class_group],ax   ; save group entry segment of class-setting segment, only used by DOSSEG
    jmp SHORT csf_7         ; bypass class selected code

; class has already been selected
csf_6:
    cmpsb                   ; compare a entry class name char to current class name char
    je  csf_6a              ; okay so far

csf_restore:
	push	es
	pop	ds					; restore ds -> WarpLink's data
    mov es,bx               ; restore es -> segdef entry
    inc word [entry_number]        ; bump to next segdef entry
    jmp NEAR PTR csf_segblk_loop    ; loop back to check next segdef entry

csf_6a:
    mov al,[es:di-1]        ; two matching zero bytes signals end of compare
    or al,[si-1]
    jne csf_6               ; nonzero, keep looping

; now, if the DOSSEG switch is tripped, compare and see if the group
; entries match.  If not, then do not group them together.
    cmp byte [es:is_dosseg],0      ; see if DOSSEG segment ordering in force
    je  csf_7               ; no

    mov dx,es               ; save es -> WarpLink data
    mov es,bx               ; es -> segdef entry
    mov ax,[es:16]          ; get group entry segment, if any
    mov es,dx               ; es -> WarpLink data
    cmp ax,[es:class_group]   ; see if group entry segment matches class-setting segment group
    jne csf_restore         ; no, don't use this segment

csf_7:
	push	es
	pop	ds					; restore ds -> WarpLink data
    mov es,bx               ; restore es -> segdef entry
    mov dl,[es:26]          ; dl holds acbp byte
    mov dh,dl
    and dh,0e0h             ; dh holds align field
    mov BYTE PTR [es:27],1  ; flag that this segment was resolved
    mov byte [res_occurred],1      ; flag that a segment was resolved this pass
    dec word [unresolved_segs]     ; decrement number of unresolved segments

    or  dh,dh               ; check if absolute frame address, align field==0
    jne csf_8               ; not absolute, resolve segment

; absolute segment, do not resolve segment
    jmp NEAR PTR csf_next_entry ; bump entry count and reloop

; not an absolute frame address resolve segment address
csf_8:
    mov ax, word [segment_start] ; get low word of segment start
    mov bl, dh			; = acbp byte
    call align_ax_from_bl

; ax holds amount to add to segment start
csf_adj_segstart:
    add WORD PTR [segment_start],ax   ; adjust low word
    adc WORD [segment_start+2],0  ; add in carry from low word

csf_10a:
    mov ax,WORD PTR [segment_start]
    mov [es:2],ax           ; save segment's start address low word
    mov ax,WORD PTR [segment_start+2]
    mov [es:4],ax           ; save segment's start address high word

    mov al,[res_incflag]
    or  al,al               ; see if should resolve incremental link segment info
    je  csf_10b             ; no
    and al,1                ; zero al passed parameter if SYMBOLS (value of 2)
    call    res_ilfseg      ; resolve segment information in ILF file

csf_10b:
    mov al,dl               ; get acbp byte
    and ax,2                ; check big bit status
    shr ax,1                ; make word value from bit either 1 or 0
    mov bx,[es:6]           ; get segment length from segdef entry
    mov WORD PTR [true_seg_len],bx    ; save low word of segment length
    mov WORD PTR [true_seg_len+2],ax  ; save high word of segment length
    mov dh,dl               ; get acbp byte
    and dh,1ch              ; get combine field
    cmp dh,14h              ; check if segment is a stack segment
    je  csf_11              ; yes, leave nonzero to flag stack segment
    xor dh,dh               ; zero dh to flag not at stack segment

csf_11:
    or  [stack_found],dh      ; track whether a stack segment is in the program
    and bl,1                ; check if segment length is odd
    je  csf_12              ; no
    or  dh,dh               ; check if segment is stack combine type
    je  csf_12              ; no

; stack segment cannot have odd byte length
    inc WORD PTR [es:6]     ; bump segment length by one
    cmp WORD PTR [es:6],0   ; check if overflowed to zero
    jne csf_11a             ; no
    or  BYTE PTR [es:26],2  ; set big bit in acbp byte

csf_11a:
    add WORD [true_seg_len],1 ; bump true segment length by one byte adjustment
    adc WORD [true_seg_len],0 ; carry bit to high word

;*** check for segment length overflow?

csf_12:
    or  dh,dh               ; check if stack combine type
    je csf_13               ; no
    cmp byte [is_comfile],0        ; check if .COM file type
    jne csf_13              ; yes

; set up EXE initial stack values
    mov ax,WORD PTR [true_seg_len+2]  ; check that stack segment is < 64K
    or  ax,ax
    je  csf_12a             ; not 64K

; stack exceeds 64K-2 bytes
csf_stack_err:
    mov dx,OFFSET exe_name wrt DGROUP
    mov ax,STACK_SIZE_ERR   ; stack segment too big
    jmp NEAR PTR link_error ; transfer control to error handler

csf_12a:
    cmp WORD [true_seg_len],65534 ; check that stack segment is < 64K-2
    ja  csf_stack_err       ; stack segment is too big

; check program's initial SS:SP value
    mov ax,WORD PTR [segment_start]   ; get low word of start in ax
    mov bx,WORD PTR [segment_start+2] ; get high word of start in bx
	mov cx, 4
@@:
    shr bx,1
    rcr ax,1                ; /2
	loop @B			; / 16

; ax == segment frame paragraph (segment start/16)
    mov [stack_segval],ax     ; save initial SS
    mov ax,WORD PTR [true_seg_len]    ; get end of stack segment (high word is zero)
    mov [stack_offval],ax     ; save initial SP

; compute segment stop address (segment_start+true_seg_len-1)
csf_13:
    mov ax,WORD PTR [segment_start]
    add ax,WORD PTR [true_seg_len]    ; ax contains low word of sum
    mov bx,WORD PTR [segment_start+2]
    adc bx,WORD PTR [true_seg_len+2]  ; bx contains high word of sum
    mov cx,ax
    or  cx,bx                       ; see if segment stop address is zero (zero length starting segment)
    je  csf_zerolen_seg             ; yes, zero the segment stop
    sub ax,1                        ; subtract one from value
    sbb bx,0                        ; borrow from high word

; bx:ax == segment stop value
    cmp bx,WORD PTR [segment_start+2] ; check that segment stop>=segment length in high word
    ja  csf_newstop                 ; yes
    je  csf_14                      ; maybe, check low word

csf_zerolen_seg:
    mov bx,WORD PTR [segment_start+2] ; make segment stop = segment length
    mov ax,WORD PTR [segment_start]
    jmp SHORT csf_newstop           ; bypass low word check

csf_14:
    cmp ax,WORD PTR [segment_start]   ; check that segment stop>=segment length in low word
    jb csf_zerolen_seg              ; no, adjust segment stop

csf_newstop:
    mov WORD PTR [segment_stop],ax    ; update segment stop variable
    mov WORD PTR [segment_stop+2],bx

    cmp byte [is_mapfile],0                ; see if need to write segments to map file
    je  csf_15                      ; no
    call    map_segments            ; yes, do it

csf_15:
    cmp WORD PTR [es:16],0          ; see if segment has associated group
    je  csf_15a                     ; nope
    call    update_grp_off          ; update group entry's offset, if necessary

csf_15a:
    mov ax,WORD PTR [true_seg_len]
    add WORD PTR [segment_start],ax   ; update low word of segment start (next segment)
    mov ax,WORD PTR [true_seg_len+2]
    adc WORD PTR [segment_start+2],ax ; update high word of segment start (next segment)

csf_next_entry:
    inc word [entry_number]        ; bump to next segdef entry
    jmp NEAR PTR csf_segblk_loop    ; loop back to check next segdef entry

csf_res_done:
    cmp byte [stack_found],0       ; check if stack segment
    je  csf_16              ; no
    cmp byte [is_comfile],0        ; check if .COM file
    je  csf_ret             ; no
	rol byte [is_comstack_set], 1
	jc csf_ret

; stack segment in .COM file, fatal error
    mov dx,OFFSET exe_name wrt DGROUP
    mov ax,COM_STACK_ERR    ; stack segment in .COM file error
    jmp NEAR PTR link_error ; transfer control to error handler

; no stack segment found
csf_16:
    cmp byte [is_comfile],0        ; check if .COM file
    jne csf_ret             ; yes

; EXE file with no stack, issue warning
	not byte [is_stack_warning]
    mov dx,OFFSET exe_name wrt DGROUP
    mov ax,NO_EXE_STACK_WARN
    call    link_warning

csf_ret:
    cmp byte [is_mapfile],0                ; see if need to write groups to map file
    je  csf_out                     ; no
    call    map_groups              ; map groups, if any

csf_out:
    ret
compute_seg_frames  ENDP

;*****************************
;* WRITE_PROGRAM             *
;*****************************

; write finished .COM or .EXE program based upon executable image
; destroys all registers except ds,es

write_program   PROC
    cmp byte [is_comfile],0        ; see if COM file
    jne wp_com              ; yes

; set .EXE header variables
wp_1:
    mov ax,[number_reloc]
    mov [exe_header.eh_numrel],ax
    mov ax,[stack_segval]
    mov [exe_header.eh_ss],ax
    mov ax,[stack_offval]
    mov [exe_header.eh_sp],ax
    mov ax,[entry_segval]
    mov [exe_header.eh_cs],ax
    mov ax,[entry_offval]
    mov [exe_header.eh_ip],ax
    jmp SHORT wp_3              ; bypass COM code

; check for proper .COM file format
wp_com:
	rol byte [is_comseg_set], 1
	jc wp_2
    cmp word [number_reloc],0      ; check if any relocation items
    je  wp_2                ; no

; can't have relocation items for a .COM file
    mov dx,OFFSET exe_name wrt DGROUP
    mov ax,COM_FIXUP_ERR    ; program has segment-relative fixups, bad .COM format
    jmp NEAR PTR link_error ; transfer control to error handler

; check if COM file has good entry point
wp_2:
    cmp word [entry_segval],0      ; see if begins at 0:100h
    je  pm_2a               ; okay so far

; bad entry point address for com file
wp_com_entry:
    mov dx,OFFSET exe_name wrt DGROUP
    mov ax,COM_ENTRY_ERR
    jmp NEAR PTR link_error ; transfer control to error handler

pm_2a:
	mov ax, [comfile_cut_length]
    cmp word [entry_offval], ax   ; check offset
    jne wp_com_entry        ; bad offset

; update temporary file from memory pages, if exists
wp_3:
    cmp byte [is_ondisk],0         ; check if temporary file in use
    je  wp_3a               ; no
    call    update_temp_file    ; flush pages to disk

wp_3a:
    cmp word [ovl_count],0         ; see if any overlays
    je  wp_3b               ; no
    call    flush_ovl_page  ; flush overlay file memory page
    call    flush_reloc_array   ; flush relocation array to disk
    cmp byte [is_emsxms_ovl],0     ; see if overlays in EMS/XMS
    je  wp_3b               ; no
    call    ems_ovl_to_file ; flush overlays from EMS/XMS to disk

wp_3b:
    mov dx,OFFSET exe_name wrt DGROUP   ; DS:DX -> ASCIIZ file specification
    mov ah,3ch              ; create/truncate file
    xor cx,cx               ; normal file attribute
    int 21h
    call    restore_ems_map
    jnc wp_4                ; no errors
    jmp NEAR PTR dos_error  ; error opening file

; write program image to highest write address (above is uninit'ed data)
; di:si will hold number of bytes to write
wp_4:
    mov [exe_handle],ax       ; keep file handle of executable file
    mov si,WORD PTR [highest_exe_write]   ; get low word
    mov di,WORD PTR [highest_exe_write+2] ; get high word
    add si,1                ; amount to write is one more than highest write amount
    adc di,0                ; carry to high word

    cmp  byte [is_comfile],0       ; check if .COM file
    je  wp_5                ; no

	rol byte [is_combig_set], 1
	jc wp_com2
    or  di,di               ; check if file is 64K or larger
    je  wp_com2             ; no
    cmp di,2                ; check that file doesn't exceed 64K in high word
    jae wp_com_size         ; it does, com file too large
    or  si,si               ; file is at least 64K, check that it isn't more
    je  wp_com2             ; file is exactly 64K

; .COM file is larger than 65536 bytes
wp_com_size:
    mov dx,OFFSET exe_name wrt DGROUP
    mov ax,COM_SIZE_ERR     ; program larger than 64K, bad .COM format
    jmp NEAR PTR link_error ; transfer control to error handler

; start writing offset 100h for .COM file
wp_com2:
	mov ax, word [comfile_cut_length]
	mov word [skip_length], ax
    mov bx,[exe_handle]       ; file handle
    jmp NEAR PTR wp_write_img   ; bypass EXE relocation table write code

wp_5:
; compute size of and allocate space for uninit'ed data
    mov ax,WORD PTR [image_size]
    mov bx,WORD PTR [image_size+2]    ; bx:ax == program image size
    sub ax,si               ; subtract low word of executable bytes
    sbb bx,di               ; subtract high word of executable bytes
    add ax,15
    adc bx,0                ; force paragraph computation to round up
	mov cx, 4
@@:
    shr bx,1
    rcr ax,1                ; /2
	loop @B			; /16, ax holds paragraphs of uninit'ed data
    mov [exe_header.eh_minalloc],ax   ; save it as exe header value

    mov ax,si               ; get low word of executable bytes
    and ax,511              ; make file length modulo 512
    mov [exe_header.eh_flen],ax   ; save as exe header value

    xor bx,bx
    mov ax,[number_reloc]     ; get number of relocation items
	mov cl, 2
@@:
    shl ax,1                ; convert items to bytes (4 bytes/item)
    rcl bx,1                ; x2
	loop @B			; x4, bx:ax holds relocation item bytes
    add ax,[exe_header.eh_roff]   ; get header size in bytes
    adc bx,0                ; carry to bx
    test    ax,511          ; see if on 512-byte boundary
    je  wp_6                ; yes
		; The above branch cannot currently be taken because
		;  exeRelocTable (eh_roff) is a constant 30 and the
		;  amount of bytes used by the relocation table is
		;  always a multiple of 4. So ax & 511 is always a
		;  nonzero value.
		; Note that this calculation of the padding length
		;  must match the write length determined for the
		;  zero_table write to the executable output file.
    mov ch,512 >> 8		; cl already 0
    mov dx,ax
    and dx,511              ; get odd page value in dx
    sub cx,dx               ; compute amount to add to bring to 512-byte boundary
    add ax,cx               ; add in amount
    adc bx,0                ; carry to bx

wp_6:
    push    bx              ; save header size in bytes high word
    push    ax              ; save header size in bytes low word
	mov cx, 4
@@:
    shr bx,1                ; convert header size to paragraphs
    rcr ax,1                ; /2
	loop @B			; /16, ax holds header size in paragraphs
				; bx should be zero value by this shift
    mov [exe_header.eh_hsize],ax  ; save as exe header value

    xor cx,cx               ; adjustment value to bring to 512-byte boundary
    mov ax,si               ; get low word of executable bytes
    and ax,511              ; see if already on 512-byte boundary
    je  wp_7                ; yes
    mov cx,512
    sub cx,ax               ; compute amount to add to bring to 512-byte boundary

wp_7:
    mov bx,di
    mov ax,si
    add ax,cx               ; bring file size to 512-byte boundary
    adc bx,0                ; carry to bx
    pop cx                  ; get header size in bytes low word
    pop dx                  ; get header size in bytes high word
    add ax,cx
    adc bx,dx               ; get file size INCLUDING header in bytes

; compute file size in 512-byte pages
    mov al,ah
    mov ah,bl
    mov bl,bh
    xor bh,bh               ; register shifts do effective divide by 256
    shr bx,1
    rcr ax,1                ; /512
    mov [exe_header.eh_fsize],ax  ; save file size in 512-byte pages in exe header

    cmp byte [is_stackval],0       ; see if stack value specified
    je  wp_8                ; no
    mov ax,WORD PTR [image_size]
    mov bx,WORD PTR [image_size+2]    ; bx:ax == program image size
    mov cx,[stack_segval]
    xor dx,dx
    shl cx,1                ; convert paragraphs available in cx into bytes in dx:cx
    rcl dx,1                ; x2
    shl cx,1
    rcl dx,1                ; x4
    shl cx,1
    rcl dx,1                ; x8
    shl cx,1
    rcl dx,1                ; x16, paragraph converted to bytes
    sub ax,cx
    sbb bx,dx               ; bx:ax holds program bytes above stack allocation start
    or  bx,bx               ; see if >64K (always room for stack specified)
    jne wp_7a               ; yes
    mov cx,[stack_value]
    sub cx,ax               ; see if remainder is > specified stack
    jc  wp_7a               ; yes

; specified stack is greater than memory image, bump minimum value by difference (in paras)
    add cx,15               ; round up to next paragraph
    shr cx,1
    shr cx,1
    shr cx,1
    shr cx,1                ; bytes converted to paragraphs
    add [exe_header.eh_minalloc],cx   ; add to previous minimum value

; set new stack value
wp_7a:
    mov ax,[stack_value]
    mov [exe_header.eh_sp],ax

; see if maximum paragraph allocation space specified
; if less than minimum, give feeback and set to minimum
wp_8:
    cmp byte [is_maxparval],0      ; see if allocation value specified
    je  wp_8a               ; no
    mov ax,[maxpar_value]     ; get allocation value
    mov [exe_header.eh_maxalloc],ax   ; save it in header variable
    cmp ax,[exe_header.eh_minalloc]   ; make sure >= minimum allocation
    jae wp_8a               ; okay value

; specified maximum paragraph allocation is less than minimum
    mov dx,OFFSET maxalloc_warn wrt DGROUP  ; ds:dx -> write buffer area
    mov cx,[maxalloc_len]
    mov bx,STDOUT
    mov ah,40h              ; write to standard output device
    int 21h
    call    restore_ems_map

    mov ax,[exe_header.eh_minalloc]   ; get minimum allocation
    mov [exe_header.eh_maxalloc],ax   ; save as maximum

; write .EXE file header
wp_8a:
    mov dx,OFFSET exe_header wrt DGROUP ; ds:dx -> write buffer area
    mov cx,30               ; size of EXE header control info
    mov bx,[exe_handle]       ; file handle
    mov ah,40h              ; write to file
    int 21h
    call    restore_ems_map
    jc  wp_to_dos_error     ; error writing to file

    cmp ax, cx			; see if out of disk space
    je wp_9a			; no

; out of disk space for executable file
wp_diskspace:
    mov ax,DISK_FULL_ERR
    mov dx,OFFSET exe_name wrt DGROUP
    jmp NEAR PTR link_error ; transfer to error handler

wp_9a:
    mov ax,[first_relblk_ptr] ; get first relocation table block

wp_rel_loop:
    or  ax,ax               ; check that is non-null
    je  wp_10               ; no more relocation entries
    push    ds              ; save ds -> warplink data segment, used
    mov ds,ax               ; ds -> block
    mov dx,4                ; ds:dx -> relocation items to write
    mov cx,[0]           ; get number of entries
    shl cx,1
    shl cx,1                ; entries * 4 == byte count to write
    mov ah,40h              ; write to file
    int 21h
    call    restore_ems_map
	jc @F
    cmp ax, cx			; see if out of disk space
    jne  wp_diskspace        ; yes
    mov ax,[2]           ; get pointer to next block, if any
    pop ds                  ; restore ds -> warplink data
    jmp wp_rel_loop         ; no errors, loop for next block write

@@:
	pop ds
    mov dx,OFFSET exe_name wrt DGROUP
    jmp NEAR PTR dos_error  ; error writing to file

wp_10:
    xor cx,cx
    mov ax,[number_reloc]
    shl ax,1
    rcl cx,1                ; x2
    shl ax,1
    rcl cx,1                ; x4, cx:ax hold bytes of relocation items
    add ax,[exe_header.eh_roff]   ; add in header offset, ignore carry
	and ax, 511		; get header size modulo 512 (0..511)
	mov cx, 512		; cx = 512
	sub cx, ax		; cx = 512 - header size modulo 512 (1..512)
	and ch, 511 >> 8	; convert 512 to 0, so cx = 0..511,
				;  now cx holds number of zero byte values
				;  needed for header to be on 512-byte page
	jcxz wp_write_img	; no bytes needed
		; The above branch never is taken currently, because the
		;  exeRelocTable (eh_roff) field is always a constant 30
		;  (001Eh) and the calculated amount of bytes for the
		;  relocation table is always a multiple of 4. Therefore,
		;  the header size modulo 512 is never equal to zero.
		; This calculation must match the code around wp_6 which
		;  calculates exeHeaderSize (eh_hsize).

    mov dx,OFFSET zero_table wrt DGROUP ; ds:dx point to table of zeros to write
    mov ah,40h              ; write to file
    int 21h
    call    restore_ems_map
	jnc @F			; no errors

wp_to_dos_error:
    mov dx,OFFSET exe_name wrt DGROUP
    jmp NEAR PTR dos_error  ; error writing to file

@@:
    cmp ax, cx			; see if out of disk space
    jne  wp_diskspace        ; yes

wp_write_img:
    cmp byte [is_ondisk],0         ; check if memory image is on disk
    je  wp_mem_write        ; no

    call    dump_temp_file  ; dump temporary file bytes into executable file
    jmp SHORT wp_ovlclose   ; close overlay file if exists

; transfer program to disk in 64K-16 chunks
; di:si contain number of bytes to write, bx == file handle
wp_mem_write:
    mov cx, 0FFF0h		; number of bytes to write (64K-16)
    test di, di			; see if byte count to write is 64K or more
    jne wp_11			; yes, write a 64K-16 chunk -->
    cmp si, cx			; see if byte count is at least 64K-16
    jae wp_11

; transfer leftover bytes (file size modulo 0fff0h)
    mov cx, si			; cx holds bytes to write
    jcxz wp_ovlclose		; no bytes to write

wp_11:
    mov ax,[image_mem_ptr]
    xor dx,dx               ; zero offset of write buffer
	push cx
	xchg dx, word [skip_length]	; reset for next iteration, dx -> data
	sub cx, dx			; skip this part
	jae @F				; if not negative -->
    mov ax,INTERNAL_ERR     ; put warplink error code in ax
    mov cx, 53              ; internal error value
    jmp NEAR PTR link_error ; transfer control to error handler

@@:
	test dx, dx
	jz @F
	push cx
	push es
	push ax
	mov cx, dx
	mov es, ax
	call check_com_cut
	pop ax
	pop es
	pop cx
@@:
    push    ds              ; save ds, critical register
    mov ds,ax               ; ds -> segment to start write
    mov ah,40h              ; write to file
    int 21h
    call    restore_ems_map
    pop ds                  ; restore ds -> warplink data
    jc wp_to_dos_error
    cmp ax, cx			; see if out of disk space
    jne  wp_diskspace        ; yes
	pop cx
    sub si, cx           ; back off number of bytes written from bytes to write
    sbb di,0                ; borrow to high word
    add word [image_mem_ptr],0fffh ; adjust segment pointer past 64K-16 written (4K-1 paragraphs)
    jmp SHORT wp_mem_write  ; loop for next write

wp_ovlclose:
    mov bx,[ovl_handle]       ; get overlay file handle
    or  bx,bx               ; make sure nonzero
    je  wp_ret              ; zero, don't close (no file)

    cmp byte [is_internal],0       ; check if temporary overlay file
    jne wp_tmpovl           ; yes
    mov ah,3eh              ; close overlay file
    int 21h
    call    restore_ems_map
    jmp SHORT wp_ret        ; bypass temporary overlay file code

wp_tmpovl:
    call    dump_ovl_file   ; dump temporary overlay file to end of executable file

wp_ret:
    rol byte [is_wlcalc_enabled], 1
    jnc @F
_wlcalc_do_pass:
	xor ax, ax
	call patch_wlcalc_sites
	inc word [_wlcalc_pass]
	mov ax, word [_wlcalc_pass]
	cmp ax, word [_wlcalc_maximum_pass]
	jbe _wlcalc_do_pass
@@:
do_comseg:
	cmp byte [is_comfile], 0
	je .none
	rol byte [is_comseg_set], 1
	jnc .none
    mov bx,[exe_handle]
    mov ax,[first_relblk_ptr] ; get first relocation table block
.loopouter:
	test ax, ax		; check that is non-null
	jz .done		; no more relocation entries
	push ds
	pop es			; es => DGROUP
    push    ds              ; save ds -> warplink data segment, used
    mov ds,ax               ; ds -> block
    mov si,4                ; ds:dx -> relocation items to write
    mov di,[0]           ; get number of entries
	test di, di
	jz .nextouter
.loopinner:
	lodsw
	push ax			; = offset
	lodsw
	xchg dx, ax
	xor ax, ax		; ax:dx = segment
	mov cx, 4
@@:
	shl dx, 1
	rcl ax, 1
	loop @B			; ax:dx = linear from segment
	pop cx
	add dx, cx
	adc ax, 0		; ax:dx = linear
	xchg cx, ax		; cx:dx = linear
	sub dx, word [es:comfile_cut_length]
	sbb cx, 0		; = file seek

	mov ax, 4200h
	int 21h			; seek to relocation
	jc .dos_error

	push ds
	 push ss
	 pop ds			; => stack
	push ax			; make space for word buffer
	mov dx, sp
	mov cx, 2
	mov ah, 3Fh
	int 21h			; read word
	jc .dos_error
	cmp ax, cx
	je @F
	mov ax, -2		; short read code
.dos_error:
	jmp wp_to_dos_error

@@:
	pop ax			; get word read from file
	add ax, word [es:comseg_relocation_factor]
				; apply relocation
	push ax			; put it back onto the stack
	mov cx, -1
	mov dx, -2
	mov ax, 4201h
	int 21h			; seek back
	jc .dos_error
	mov dx, sp
	mov cx, 2
	mov ah, 40h
	int 21h			; write word
	jc .dos_error
	cmp ax, cx
	je @F
	mov ax, 27h
	jmp .dos_error
@@:
	pop ax			; discard stack variable
	pop ds
	dec di			; count down this block's relocations
	jnz .loopinner		; more to go -->
.nextouter:
    mov ax,[2]           ; get pointer to next block, if any
    pop ds                  ; restore ds -> warplink data
    jmp .loopouter         ; no errors, loop for next block write

.done:
.none:
    mov bx,[exe_handle]
    mov ah,3eh              ; close executable file
    int 21h
    call    restore_ems_map
 extern delete_wllist_temps
	xor ax, ax
	call delete_wllist_temps
    ret
write_program   ENDP


		; INP:	al = 0 if normal run (post-link)
		;	al = 1 if to create relocations
		; CHG:	all
		; STT:	ds => DGROUP
		; REM:	based on mlmap.nas map_publics
 global patch_wlcalc_sites
patch_wlcalc_sites:
	mov byte [_wlcalc_create_relocations], al
    mov ax,[first_pdeclblk_ptr]   ; get pointer to first public declarations block
    or  ax,ax               ; check if non-null
    jne pws_blkloop          ; non-null, public declarations exist
    jmp NEAR PTR pws_communal_chk    ; null, try communal declarations block

pws_blkloop:
    push    ax              ; save -> block on stack
    mov es,ax               ; es -> declarations block
    mov si,[es:0]           ; get count of entries in block

pws_entloop:
	or word [_wlcalc_obj_index], -1
    inc ax                  ; ax -> next entry in block
    mov es,ax               ; es -> declaration entry
    push    es              ; save -> declaration entry

; 12/21/92
;***	test    BYTE PTR [es:15],20h    ; see if local communal (don't list locals)
    test    BYTE PTR [es:15],24h    ; see if local

    je  pws_not_local        ; no

pws_noprint:
    pop es                  ; restore stack
    jmp NEAR PTR pws_next_entry  ; try next entry in block

pws_not_local:
    test    BYTE PTR [es:14],3  ; see if weak extdef
    je  pws_noprint          ; yes, don't print it

    mov ah,[es:15]          ; get general flags
    test    ah,1            ; get in overlay flag
    jne pws_overlaid         ; set, in overlay, zero segment offset
    mov al,[es:14]          ; get definition flag
    and al,3                ; get definition bits
    cmp al,3                ; see if absolute
    jne pws_not_abs          ; no

; absolute symbol
    mov cx,[es:2]           ; get frame number in cx

pws_zero_offset:
    xor di,di               ; di==low nybble of segment offset (always zero)
    jmp SHORT pws_3          ; bypass segment frame code

pws_not_abs:
    cmp al,2                ; see if resolved
    je  pws_2a               ; yes
    xor cx,cx               ; zero frame
    jmp SHORT pws_zero_offset    ; go to zero offset code

pws_overlaid:
    xor cx,cx               ; zero frame
    mov di,cx               ; zero public offset
    jmp SHORT pws_3          ; bypass segment frame code

pws_2a:
    mov es,[es:0]           ; es -> segment partition entry
	cmp word [es:file_mod_id + 2], 0
	jne @F
	mov cx, word [es:file_mod_id]
	mov word [_wlcalc_obj_index], cx
@@:
    mov cx,[es:0]           ; get segment partition offset
    mov es,[es:4]           ; es -> segdef entry

    and ah,80h              ; see if public is in group
    je  pws_2b               ; no

    mov di,cx               ; di holds segment partition entry offset

    mov cx,[es:2]           ; get low word of segment offset
    mov ax,[es:4]           ; get high word of segment offset
    pop es                  ; es -> public declaration entry
    push    es              ; restore -> public declaration entry to stack
    mov es,[es:2]           ; es -> group entry
    sub cx,[es:0]           ; compute low word difference in group/segment offset
    sbb ax,[es:2]           ; compute high word difference in group/segment offset
    add di,cx               ; add difference into di, public offset

    mov ax,[es:0]           ; get low word of group offset
    mov cx,ax               ; save in cx
    and ax,0fh              ; get paragraph remainder
    add di,ax               ; add to public offset

    mov ax,[es:2]           ; get high word of group offset
    shr ax,1                ; convert offset in ax:cx to paragraphs
    rcr cx,1                ; /2
    shr ax,1
    rcr cx,1                ; /4
    shr ax,1
    rcr cx,1                ; /8
    shr ax,1
    rcr cx,1                ; /16
    jmp SHORT pws_3          ; bypass segment specific code

; non-group public
pws_2b:
    mov di,[es:2]           ; get low word of segment offset
    and di,0fh              ; di==low nybble of segment offset
    add di,cx               ; add in segment partition entry offset

 extern seg_offset_to_para
    call    seg_offset_to_para  ; get segment offset in paragraphs (frame) in cx

pws_3:
	mov word [_wlcalc_segment], cx
    pop es                  ; es -> declaration entry
    add di,[es:8]           ; add in public offset
    mov cx,di
	mov word [_wlcalc_offset], cx

pws_4:
    mov al,[es:15]          ; get general flag
    and al,1                ; see if overlaid
    jne pws_ovl              ; yes
    mov al,[es:14]          ; get definitions flag
    and al,3                ; get definition bits
    cmp al,3                ; see if absolute
    je  pws_abs              ; no
    cmp al,2                ; see if resolved public/communal
    jne pws_unres            ; no
    test    BYTE PTR [es:15],40h    ; see if communal
    je  pws_res              ; no, resolved public

;communal variable
    jmp SHORT pws_print_pubtype

; overlaid variable
pws_ovl:
    push    es              ; save critical register
    mov es,[es:0]           ; es -> segment partition entry
    mov cx,[es:4]           ; get overlay identifier
    pop es                  ; restore critical register
; absolute variable
pws_abs:
; resolved public
pws_res:
; unresolved public
pws_unres:
pws_print_pubtype:
    push    ds              ; save critical register

handle_wlcalc:
    lds di,[es:4]           ; get -> pubdef name in es:bx
	push ds
	push es
	push si
	push di
	push bx
	lframe
	lvar word, do
	lvar word, size
	lequ 10, buffersize
	lvar ?buffersize, buffer
	lenter
	 push ds
	 push di
	lvar dword, namepointer
	xor ax, ax
	 push ax
	lvar word, pass
	 push ax
	inc ax
	 push ax
	lvar dword, repeat

	mov si, di
	mov ax, DGROUP
	mov es, ax
	mov di, string_wlcalc
@@:
	cmpsb
	jne .check
	cmp byte [si - 1], 0
	jne @B

.unknown:
    mov ax,_WLCALC_ERR

.wlcalc_error:
	cmp byte [es:_wlcalc_create_relocations], 0
	jne .mismatch_pop
	rol byte [es:is_wlcalc_error_as_warning], 1
	jnc @F
		; warning only
	call .copy_namepointer
	call .get_object_filename
	mov di, name_field
	call link_warning	; give warning feedback
	jmp .mismatch_pop
@@:
		; error on first unknown
	jmp .wlcalc_always_error

.overflow:
    mov ax,_WLCALC_OVERFLOW_ERR

.wlcalc_always_error:
	call .copy_namepointer
	call .get_object_filename
    mov cx,OFFSET name_field wrt DGROUP ; cx -> symbol name for this error
    jmp NEAR PTR link_error	; transfer control to error handler

 extern obj_block_ptr, get_curr_obj, pos_in_list
 global handle_wlcalc.get_object_filename
 global _wlcalc_obj_index

 extern name_field
.copy_namepointer:
	mov cx, DGROUP
	mov es, cx
	mov di, name_field
	mov cx, words(256)
	lds si, [bp + ?namepointer]
	rep movsw
	retn

.get_object_filename:
	mov cx, DGROUP
	mov ds, cx
	mov es, cx
	push ax
	push word [current_obj]
	push word [obj_block_ptr]
	push word [pos_in_list]
	cmp word [_wlcalc_obj_index], -1
	jne @F
	mov si, string_unknown_filename
	mov cx, string_unknown_filename.size
.gof_fill:
	mov di, filename
	rep movsb
	jmp .gof_done
@@:
    and word [current_obj],0       ; init current object module number
    mov ax,[first_objblk_ptr]
    mov [obj_block_ptr],ax    ; init current block pointer to first block

.gof_loop:
    mov ax,[obj_count]        ; get total count of object modules
    cmp ax,[current_obj]      ; end loop when current equals total
    ja  .gof_getobj           ; more object modules
	mov si, string_invalid_filename
	mov cx, string_invalid_filename.size
	jmp .gof_fill

.gof_getobj:
	call get_curr_obj
	mov ax, [current_obj]
	cmp ax, [_wlcalc_obj_index]
	je .gof_done
	inc word [current_obj]
	jmp .gof_loop

.gof_done:
	mov dx, filename
	pop word [pos_in_list]
	pop word [obj_block_ptr]
	pop word [current_obj]
	pop ax
	retn

.check:
	cmp byte [es:di - 1], 0
	jne .mismatch_pop
.match:
	dec si
@@:
	lodsb
	cmp al, '_'
	je @B
	dec si
	mov dx, si
	mov bx, _wlcalc_size_table - 4
.getsizeloop:
	add bx, 4
	mov di, [es:bx]
	test di, di
	jz .unknown_size
	mov si, dx
@@:
	cmpsb
	jne .checksize
	cmp byte [si - 1], 0
	jne @B
	jmp .unknown_size_only

.checksize:
	cmp byte [es:di - 1], 0
	jne .getsizeloop
	push word [es:bx + 2]
	pop word [bp + ?size]

	dec si
@@:
	lodsb
	cmp al, '_'
	je @B
	dec si
	mov dx, si
	mov di, string_pass
@@:
	cmpsb
	jne .checkpassearly
	cmp byte [si - 1], 0
	jne @B
	jmp .notpassearly

.checkpassearly:
	cmp byte [es:di - 1], 0
	jne .notpassearly

	dec si
@@:
	lodsb
	cmp al, '_'
	je @B
	dec si
	call _wlcalc_parse_number.decimalonly
	jnc @F
	jz .overflow_pass
	jmp .unknown_invalid_pass

@@:
	test dx, dx
	jnz .overflow_pass
	cmp word [es:_wlcalc_maximum_pass], ax
	jae @F
	mov word [es:_wlcalc_maximum_pass], ax
@@:
	mov word [bp + ?pass], ax
	db __TEST_IMM16		; skip mov si

.notpassearly:
	mov si, dx
@@:
	lodsb
	cmp al, '_'
	je @B
	dec si
	call .getdo

	or word [es:_wlcalc_wrt_pointer], -1
	cmp word [bp + ?do], _wlcalc_do_wrt
	jne .notwrt

	mov ah, '_'
	cmp byte [si], '@'
	jne @F
	inc si
	lodsb
	mov ah, al
	test al, al
	jnz @F
	mov ax, _WLCALC_QUOTE_NUL_ERR
	jmp .wlcalc_error
@@:
	call .get_seg_ext_name_ah
@@:
	lodsb
	cmp al, ah
	je @B
	cmp al, '_'
	je @B
	dec si
	push ds
	call _wlcalc_get_segdef_entry
	jnc @F
	call _wlcalc_get_grpdef_entry
	jnc @F
	push ds
	pop es
	jmp .seg_not_found_error
@@:
	mov word [_wlcalc_wrt_pointer], bx
	mov word [_wlcalc_wrt_pointer + 2], es
	 push ds
	 pop es
	pop ds
	mov bx, _wlcalc_do_table.ext - 4
	call .getdo_bx

.notwrt:
	cmp word [bp + ?do], _wlcalc_do_opext
	jne .notopext

	call .getdo
	cmp word [bp + ?do], _wlcalc_highest_seg_ext
	jbe .unknown_opext_invalid
	call .get_seg_ext_name
	push es
	pop ds			; => DGROUP

	cmp byte [_wlcalc_create_relocations], 0
	jne .mismatch_pop	; do it later only -->

	call _wlcalc_perform_fixup
	jc .wlcalc_error_j1
		; dx:ax = number
	jmp .ext_common

.getdo:
	mov bx, _wlcalc_do_table - 4
.getdo_bx:
	mov dx, si
.getdoloop:
	add bx, 4
	mov di, [es:bx]
	test di, di
	jz .unknown_do
	mov si, dx
@@:
	cmpsb
	jne .checkdo
	cmp byte [si - 1], 0
	jne @B
	jmp .unknown_do_only

.checkdo:
	cmp byte [es:di - 1], 0
	jne .getdoloop
	push word [es:bx + 2]
	pop word [bp + ?do]

	dec si
@@:
	lodsb
	cmp al, '_'
	je @B
	dec si
	retn


.get_seg_ext_name:
	mov ah, 0
.get_seg_ext_name_ah:
	mov dx, si
@@:
	lodsb
	cmp al, ah
	je @F
	cmp al, 0
	je @F
	cmp al, '?'
	jne @B
@@:
	dec si
	mov cx, si
	sub cx, dx
	mov si, dx

%if 0
	push ax
	mov ah, 40h
	mov bx, 1
	int 21h
	mov ah, 02h
	mov dl, 13
	int 21h
	mov ah, 02h
	mov dl, 10
	int 21h
	pop ax
%endif

	mov di, name_field
	rep movsb
	mov al, 0
	stosb
	retn


.notopext:
	cmp word [bp + ?do], _wlcalc_do_minusext
	je @F
	cmp word [bp + ?do], _wlcalc_do_ext
	je @F
	cmp word [bp + ?do], _wlcalc_do_minusextpara
	je @F
	cmp word [bp + ?do], _wlcalc_do_extpara
	je @F
	cmp word [bp + ?do], _wlcalc_do_minussegrel
	je @F
	cmp word [bp + ?do], _wlcalc_do_segrel
	je @F
	cmp word [bp + ?do], _wlcalc_do_seg
	jne .notseg
	cmp word [bp + ?size], 2
	jne .unknown_seg_nonword
	cmp word [es:_wlcalc_offset], -1
	je .overflow
@@:
	call .get_seg_ext_name
	cmp word [bp + ?do], _wlcalc_do_minusext
	je .ext
	cmp word [bp + ?do], _wlcalc_do_ext
	je .ext
	cmp word [bp + ?do], _wlcalc_do_minusextpara
	je .ext
	cmp word [bp + ?do], _wlcalc_do_extpara
	je .ext
	call _wlcalc_get_segdef_entry
	jnc @F
	call _wlcalc_get_grpdef_entry
	jnc @F
	push ds
	pop es
.seg_not_found_error:
	mov ax, _WLCALC_SEG_NOT_FOUND_ERR
	jmp .wlcalc_error_j1

.unknown_size:
	mov ax, _WLCALC_UNKNOWN_SIZE_ERR
.wlcalc_error_j1:
	jmp .wlcalc_error

.unknown_size_only:
	mov ax, _WLCALC_MISSING_OPERATION_ERR
	jmp .wlcalc_error_j1

.overflow_pass:
	mov ax, _WLCALC_OVERFLOW_PASS_ERR
.wlcalc_always_error_j1:
	jmp .wlcalc_always_error

.unknown_invalid_pass:
	mov ax, _WLCALC_INVALID_PASS_ERR
	jmp .wlcalc_error_j1

.unknown_opext_invalid:
	mov ax, _WLCALC_OPEXT_INVALID_ERR
	jmp .wlcalc_error_j1

.unknown_do:
	mov ax, _WLCALC_UNKNOWN_DO_ERR
	jmp .wlcalc_error_j1

.unknown_do_only:
	mov ax, _WLCALC_MISSING_OPERAND_ERR
	jmp .wlcalc_error_j1

.unknown_seg_nonword:
	mov ax, _WLCALC_SEG_NOT_WORD_ERR
	jmp .wlcalc_error_j1

.overflow_constant:
	mov ax, _WLCALC_OVERFLOW_CONSTANT_ERR
	jmp .wlcalc_always_error_j1

.unknown_invalid_constant:
	mov ax, _WLCALC_INVALID_CONSTANT_ERR
	jmp .wlcalc_error_j1

.unknown_repeat_only:
	mov ax, _WLCALC_MISSING_REPEAT_ERR
	jmp .wlcalc_error_j1

.overflow_repeat:
	mov ax, _WLCALC_OVERFLOW_REPEAT_ERR
	jmp .wlcalc_always_error_j1

.unknown_invalid_repeat:
	mov ax, _WLCALC_INVALID_REPEAT_ERR
	jmp .wlcalc_error_j1

.unknown_pass_only:
	mov ax, _WLCALC_MISSING_PASS_ERR
	jmp .wlcalc_error_j1

.unknown_trailer:
	mov ax, _WLCALC_UNKNOWN_TRAILER_ERR
	jmp .wlcalc_error_j1

@@:
	cmp byte [_wlcalc_create_relocations], 0
	je .seg_value
	cmp word [bp + ?do], _wlcalc_do_seg
	jne .skip		; segrel or minussegrel -->

	mov ax, word [_wlcalc_segment]
	xor dx, dx
	mov word [data_segment], ax
	mov cx, 4
@@:
	add ax, ax
	adc dx, dx
	loop @B
	add ax, word [_wlcalc_offset]
	adc dx, cx

	mov word [data_offset], ax
	mov word [data_offset + 2], dx
	xor dx, dx
 extern make_reloc_entry
	call make_reloc_entry
.skip:
	jmp .mismatch_pop

.seg_value:
    mov ax,[es:bx + 0]           ; get low word of segment offset
    mov bx,[es:bx + 2]           ; get high word of segment offset
    shr bx,1
    rcr ax,1                ; /2
    shr bx,1
    rcr ax,1                ; /4
    shr bx,1
    rcr ax,1                ; /8
    shr bx,1
    rcr ax,1                ; /16, have paragraph value of offset (segment value)
	push bx
	push ax
	cmp word [bp + ?do], _wlcalc_do_minussegrel
	mov word [bp + ?do], _wlcalc_do_add
	jne @F			; not minussegrel -->
	mov word [bp + ?do], _wlcalc_do_sub
@@:
	push ds
	pop es			; => DGROUP
	jmp .norepeat

.ext:
	push es
	pop ds			; => DGROUP

	cmp byte [_wlcalc_create_relocations], 0
	jne .mismatch_pop	; do it later only -->

	call _wlcalc_perform_fixup
	jc .wlcalc_error_j1
		; dx:ax = number
	cmp word [bp + ?do], _wlcalc_do_extpara
	je .extpara
	cmp word [bp + ?do], _wlcalc_do_minusextpara
	jne .not_extpara
.extpara:
	mov cx, 4
	add ax, 15
	adc dx, 0
@@:
	shr dx, 1
	rcr ax, 1
	loop @B
.not_extpara:
	cmp word [bp + ?do], _wlcalc_do_minusextpara
	je .minusext
	cmp word [bp + ?do], _wlcalc_do_minusext
	mov word [bp + ?do], _wlcalc_do_add
	jne @F			; not minusext -->
.minusext:
	mov word [bp + ?do], _wlcalc_do_sub
@@:
.ext_common:
	push dx
	push ax
	push ds
	pop es			; => DGROUP
	jmp .norepeat

.notseg:
	call _wlcalc_parse_number
	jnc @F
	jz .overflow_constant
	jmp .unknown_invalid_constant

@@:
	 push dx
	 push ax
	lvar dword, number

	cmp byte [si], '?'
	je .norepeat
	cmp byte [si], 0
	je .norepeat

@@:
	lodsb
	cmp al, '_'
	je @B
	dec si
	mov dx, si
	mov di, string_repeat
@@:
	cmpsb
	jne .checkrepeat
	cmp byte [si - 1], 0
	jne @B
	jmp .unknown_repeat_only

.checkrepeat:
	cmp byte [es:di - 1], 0
	jne .trypass

	dec si
@@:
	lodsb
	cmp al, '_'
	je @B
	dec si
	call _wlcalc_parse_number
	jnc @F
	jz .overflow_repeat
	jmp .unknown_invalid_repeat

@@:
	mov word [bp + ?repeat], ax
	mov word [bp + ?repeat + 2], dx

	cmp byte [si], '?'
	je .gotrepeat
	cmp byte [si], 0
	je .gotrepeat

@@:
	lodsb
	cmp al, '_'
	je @B
	dec si
	mov dx, si
.trypass:
	mov si, dx
	mov di, string_pass
@@:
	cmpsb
	jne .checkpass
	cmp byte [si - 1], 0
	jne @B
	jmp .unknown_pass_only

.checkpass:
	cmp byte [es:di - 1], 0
	jne .unknown_trailer

	dec si
@@:
	lodsb
	cmp al, '_'
	je @B
	dec si
	call _wlcalc_parse_number
	jnc @F
	jz .overflow_pass
	jmp .unknown_invalid_pass

@@:
	cmp byte [si], '?'
	je @F
	cmp byte [si], 0
	je @F
	jmp .unknown

@@:
	test dx, dx
	jnz .overflow_pass
	push es
	pop ds		; => DGROUP
	cmp word [_wlcalc_maximum_pass], ax
	jae @F
	mov word [_wlcalc_maximum_pass], ax
@@:
	mov word [bp + ?pass], ax

.gotrepeat:
.norepeat:
	push es
	pop ds		; => DGROUP

	cmp byte [_wlcalc_create_relocations], 0
	jne .mismatch_pop

	mov ax, word [_wlcalc_pass]
	cmp word [bp + ?pass], ax
	jne .repeatzero

	mov ax, word [bp + ?repeat]
	mov dx, word [bp + ?repeat + 2]
	or ax, dx
	jz .repeatzero

	mov cx, 4
	mov ax, [exe_header.eh_hsize]	; = 0 if generating a .COM file
	xor dx, dx
@@:
	add ax, ax
	adc dx, dx
	loop @B

	xor si, si
	mov di, word [_wlcalc_segment]
	mov cl, 4
@@:
	add di, di
	adc si, si
	loop @B

	add ax, di
	adc dx, si
	jc .overflow
	add ax, word [_wlcalc_offset]
	adc dx, 0
	jc .overflow

	cmp byte [is_comfile], 0	; check if .COM file
	je @F				; no -->
	sub ax, [comfile_cut_length]
	sbb dx, 0			; adjust for .COM file entry
	jc .overflow			; mustn't write before SOF -->

@@:
	mov bx, [exe_handle]
	xchg dx, ax		; ax:dx
	xchg cx, ax		; cx:dx
	mov ax, 4200h
	int 21h
    call restore_ems_map
    jnc @F
pws_exe_error: equ $
	push es
	pop ds		; => DGROUP
    mov dx,OFFSET exe_name wrt DGROUP
    jmp NEAR PTR dos_error
@@:

.repeat:
	xor ax, ax
	mov word [bp + ?buffer], ax
	mov word [bp + ?buffer + 2], ax
	push ss
	pop ds
	lea dx, [bp + ?buffer]
	mov cx, word [bp + ?size]
	mov ah, 3Fh
	int 21h
    call restore_ems_map
	jc pws_exe_error
	cmp ax, cx
	mov ax, -2		; short read code
	jne pws_exe_error

	mov dx, cx			; = size
	neg dx				; = minus size
	mov cx, -1			; sign-extend
	mov ax, 4201h
	int 21h				; seek back
    call restore_ems_map
	jc pws_exe_error

	push es
	pop ds		; => DGROUP
	mov bx, word [bp + ?number + 2]
	mov cx, word [bp + ?number]
	mov dx, word [bp + ?buffer + 2]
	mov ax, word [bp + ?buffer + 0]
	call near [bp + ?do]
	mov bx, [exe_handle]
	jc .overflow
	mov word [bp + ?buffer + 2], dx
	mov word [bp + ?buffer + 0], ax

	push ss
	pop ds
	lea dx, [bp + ?buffer]
	mov cx, word [bp + ?size]
	mov ah, 40h
	int 21h
    call restore_ems_map
	jc pws_exe_error
	cmp ax, cx
	mov ax, 27h			; insufficient disk space error
	jne pws_exe_error

		; After a successful write, the file seek points past
		;  the written element. This is used by the REPEAT
		;  wlcalc to find the next element on which to operate.
	sub word [bp + ?repeat], 1
	jz @F
.nextsbb:
	sbb word [bp + ?repeat], 0
.repeat_j:
	jmp .repeat
@@:
	sbb word [bp + ?repeat], 0
	jnz .repeat_j

.repeatzero:
.mismatch_pop:
	lleave
	pop bx
	pop di
	pop si
	pop es
	pop ds
%if 0
    mov dx,di               ; save -> name
    xor cx,cx               ; cx will hold of chars in name

pws_loop:
    cmp BYTE PTR [di],0     ; see if zero terminator in symbol name found
    je  pws_5                ; yes
    inc cx                  ; bump count of chars in string
    inc di                  ; move to next char slot to test
    jmp SHORT pws_loop       ; loop back to test next char
%endif

pws_5:
    pop ds                  ; restore ds -> machlink data

pws_next_entry:
    mov ax,es               ; ax -> current entry
    dec si                  ; drop count of entries in block
    je  pws_next_block       ; no more entries try next block
    jmp NEAR PTR pws_entloop ; print next entry

pws_next_block:
    pop es                  ; restore es -> block
    mov ax,[es:2]           ; get pointer to next block, if any
    or  ax,ax               ; check if non-null
    je  pws_communal_chk     ; null, check communals
    jmp NEAR PTR pws_blkloop ; loop back for more publics

pws_communal_chk:
%if 0
    inc byte [comm_loop_flag]      ; bump counter
    cmp byte [comm_loop_flag],1    ; see if communal blocks printed yet
    ja  pws_ret              ; yes
    mov ax,[first_cdeclblk_ptr]   ; get pointer to first communal declarations block
    or  ax,ax               ; check if non-null
    je  pws_ret              ; null, done
    jmp NEAR PTR pws_blkloop ; non-null, print declarations in communal block
%endif

pws_ret:
    ret


		; Find a segdef entry (SEG_DEFENT_STRUC) from name
		;
		; INP:	name_field -> ASCIZ name
		; OUT:	NC if found,
		;	 ax = es => segment of entry
		;	 dword [es:bx] = segdef's offset from start of program
		;	CY if not found
		;	ds => DGROUP
		; CHG:	ax, bx, es, ds
		; REM:	based on get_segdef_entry in mlpass1b.nas
_wlcalc_get_segdef_entry:
    push    dx
    push    si
    push    di
	mov ax, DGROUP		; get warplink's data segment
    mov ds,ax               ; ds => warplink data
    mov si,OFFSET name_field wrt DGROUP ; si -> name to get hash code of
 extern get_hash
    call    get_hash        ; get hash code of name
    mov si,OFFSET segdef_hash wrt DGROUP   ; si -> base of hash pointers to segdef entries
    shl ax,1                ; convert ax to word offset
    add si,ax               ; si points to proper name hash code entry
    cmp WORD PTR [si],0     ; is hash code used (nonzero value)
	je wgse_ret_CY

; hash code used, check whether duplicate name or hash collision
wgse_2:
wgse_2a:
    mov ax,[si]             ; get segment pointer to segdef entry

wgse_testloop:
    mov es,ax               ; es -> segment of segdef entry testing name against
    xchg bx,ax               ; save entry segment in bx
    les di,[es:8]           ; -> segment name in lnames block
    add di,8                ; adjust for 2 doubleword pointers in front of name
    mov si,OFFSET name_field wrt DGROUP ; si -> name to get hash code of

; ds:si -> name, es:di -> name to test against
wgse_byteloop:
    mov al,[si]
    or  al,[es:di]          ; see if both values are zero (matched to null terminator)
    je  wgse_match           ; strings matched
    cmpsb                   ; compare a nonzero byte in the two names
    je  wgse_byteloop        ; bytes match, loop for next byte test
    mov es,bx               ; get segdef entry segment value

wgse_next_ptr:
    mov ax,[es:20]          ; get next entry
    or  ax,ax               ; check if a null pointer (ax=0)
    jne wgse_testloop        ; no, keep checking entries
	jmp wgse_ret_CY

; segment names match, check class names
wgse_match:
    mov es,bx               ; get segdef entry segment value
    xchg ax, bx			; also return ax
	db __TEST_IMM8		; NC, skip stc
wgse_ret_CY:
	stc
    pop di                  ; restore critical registersr
    pop si
    pop dx
	mov bx, sdes_offset
    ret


		; Find a grpdef entry (GRP_ENT_STRUC) from name
		;
		; INP:	name_field -> ASCIZ name
		; OUT:	NC if found,
		;	 ax = es => GRP_ENT_STRUC entry
		;	 dword [es:bx] = grpdef's offset from start of program
		;	CY else
		; CHG:	ax, bx, es
		; STT:	ds => DGROUP
		; REM:	based on get_group_entry in mlpass1c.nas
_wlcalc_get_grpdef_entry:
    push    cx
    push    dx
    push    di
    push si

    mov ax,[alloc_grpblk_ptr]
    test ax, ax               ; check if any group blocks were previously allocated
	jz wgge_ret_CY

wgge_2:
    mov es,ax               ; es -> current block
    xor dx,dx               ; dx hold group entry number

	db __TEST_IMM8		; skip pop
wgge_nomatch:
    pop es                  ; restore es -> block
wgge_grp_loop:
    cmp dx,[es:0]           ; check if any more entries in group block
    jb  wgge_3               ; yes

; no more entries in group block, get next group block
    mov ax,[es:2]           ; get pointer to next group
    test ax, ax               ; check if null, no more group blocks
    jz wgge_ret_CY
    mov es,ax               ; es -> new block
    xor dx,dx               ; re-init group entry number

wgge_3:
    push    es              ; save es -> block
    mov ax,es               ; get block segment address
    add ax,dx               ; get first free entry segment value
    inc ax                  ; adjust for block system info size of 1 paragraph
    mov es,ax               ; es -> group entry
    inc dx                  ; bump entry number
	les di, [es:ges_grp_nament_ptr]
	add di, 8		; skip pointers
	mov si, name_field
.loop:
	cmpsb			; compare byte
	jne wgge_nomatch	; mismatch, try next entry -->
	cmp byte [si - 1], 0	; matched the NUL ?
	jne .loop		; not yet -->
wgge_3a:
; names match
    pop bx                  ; trash old es value on stack
	db __TEST_IMM8		; skip stc, NC
wgge_ret_CY:
	stc
wgge_ret:
	mov es, ax
	pop si
    pop di
    pop dx
    pop cx
	mov bx, ges_offset
    ret


 extern clipper_segindex, compress_this
 extern current_segind, fixupp_offset_err, frame_ent_ptr, frame_method
 extern frext_ingroup, gen_flags, is_abspub, is_absseg, is_ind_call
 extern is_relocatable, is_resolved, loc, locat
 extern no_fixbyte_flag, no_match_okay, targ_ent_ptr, target_disp
 extern target_index, target_method, target_prog_off, target_segment

		; Perform a fixup
		;
		; INP:	name_field -> ASCIZ extern label name
		;	word [_wlcalc_wrt_pointer] = -1 if no WRT clause parsed
		;	else:
		;	 dword [_wlcalc_wrt_pointer] -> dword WRT base
		;		(this is an executable image linear address that
		;		corresponds to the relative segment value to use)
		; OUT:	CY if not found,
		;	 ax = error code
		;	 if not found, _WLCALC_EXT_NOT_FOUND_ERR
		;	 if WRT clause parsed but absolute PUBDEF,
		;	  _WLCALC_ABS_WRT_ERR
		;	NC if found,
		;	 dx:ax = resolved extern label number
		;	does not return if internal error occurs (44 to 49)
		; CHG:	ax, bx, cx, dx, si, di
		; STT:	ds => DGROUP
		; REM:	based on mlpass2d.nas perform_fixup
_wlcalc_perform_fixup:
    xor al,al
    mov [is_absseg],al        ; init absolute flags
    mov [is_abspub],al
    mov al, 0C4h		; get low byte of locat field
    mov ah, 0
    mov [locat],ax            ; save locat field to memory variable

    mov dl,al
    and dl,1ch              ; get loc field
    shr dl,1
    shr dl,1                ; make loc value relative zero
    mov [loc],dl              ; save loc value

%if 0
    mov BYTE PTR [data_rec_offset],ah ; save bit 7-0 of data record offset in locat high byte
    and al,3                ; get bit 9-8 of data record offset in locat low byte
    mov BYTE PTR [data_rec_offset+1],al   ; and save it
%endif

    mov dl, 56h			; get fix dat field
    mov dh,dl               ; dh holds fix dat field value
    and dh,70h              ; get frame field in dh
		; dh = 50h
    shr dh,1
    shr dh,1
    shr dh,1
    shr dh,1                ; make frame value relative zero
		; dh = 5h

; no thread field for frame
    cmp dh,2                ; see if index specified for this frame
    ja  wpef_5               ; no
	;int3
    mov ax,INTERNAL_ERR     ; put warplink error code in ax
    mov cx, 44              ; internal error value
    jmp NEAR PTR link_error ; transfer control to error handler

wpef_5:
    mov [frame_method],dh     ; frame method is the frame field
		; frame_method = 5

wpef_6:
    mov al,dl               ; get fix dat field
    test    al,8            ; check if thread field for target (tbit)
    jne wpef_thrdtarg        ; yes

; no thread field for target
wpef_6b:
;    mov [target_index],ax     ; target index, if any
    mov al,dl               ; get fix dat field
    and al,3                ; break out targt field
		; al = 2
    mov [target_method],al    ; target method is the targt field
    jmp SHORT wpef_7         ; bypass target thread field code

; illegal frame method is 3, 6, or 7
wpef_bad_frame:
    mov cl,bl
    mov ax,FRAME_METH_ERR
    jmp NEAR PTR fixupp_offset_err  ; transfer control to error handler

; bad target method of 3 (prior to P bit modifier)
wpef_bad_target:
    mov cl,bl
    mov ax,TARGET_METH_ERR
    jmp NEAR PTR fixupp_offset_err  ; transfer control to error handler

; thread field for target
wpef_thrdtarg:
	;int3
    mov ax,INTERNAL_ERR     ; put warplink error code in ax
    mov cx, 45              ; internal error value
    jmp NEAR PTR link_error ; transfer control to error handler

@@:
	;int3
    mov ax,INTERNAL_ERR     ; put warplink error code in ax
    mov cx, 46              ; internal error value
    jmp NEAR PTR link_error ; transfer control to error handler

; check index validity
wpef_7:
    mov bl,[frame_method]
		; frame_method = 5
		; bl = 5
	cmp bl, 5
	jne @B

wpef_8:
    mov bl,[target_method]
    cmp bl,3                ; check for bad target method
    je  wpef_bad_target      ; bad target method

    mov al,dl               ; get fix dat field
    and al,4                ; get P bit field
    or  [target_method],al    ; P bit modifies target method, merge it in

    or  al,al               ; check if P bit set
    mov ax,0                ; assume it is, setup for zero'ing target displacment, don't change flags via xor
    jne wpef_10              ; yes, P bit set, force target displacement value to zero

; get target displacement field if P bit is zero
	;int3
    mov ax,INTERNAL_ERR     ; put warplink error code in ax
    mov cx, 47              ; internal error value
    jmp NEAR PTR link_error ; transfer control to error handler

wpef_10:
    mov WORD PTR [target_disp],ax ; save target displacement value
    cwd
    mov WORD PTR [target_disp+2],dx   ; save sign extension of target displacement

; compute program offset of target address and its frame
    xor al,al
    mov [is_ind_call],al      ; init indirect call to overlaid public flag
    mov [no_fixbyte_flag],al  ; init flag for fixup bytes
    mov [gen_flags],al        ; init general flags

    inc al
    mov [is_resolved],al      ; init is_resolved flag to assume fixup okay
    call    _wlcalc_get_target_addr
	jc wpef_ret

; see if absolute segment or absolute public declaration, no frame computation
    mov al,[is_absseg]
    or  al,[is_abspub]
    jne wpef_resolved        ; either absolute segment or absolute public declaration

    mov al,[frame_method]
		; frame_method = 5
wpef_11:
    ; mov al,1                ; flag to get_frame_addr procedure to use target data
    call _wlcalc_get_frame_addr
	jnc wpef_13        ; bypass other target segment computation code

wpef_ret:
    ret                     ; early return from routine

wpef_13:
    mov al,[is_resolved]
    or  al,al               ; check if reference to unresolved external
	stc
	mov ax, _WLCALC_EXT_NOT_FOUND_ERR
    je  wpef_ret             ; yes, don't perform a fixup

; convert target segment and target program offset to segment:offset format
wpef_resolved:
; see if absolute segment or absolute public declaration, no address adjustment
    mov al,[is_absseg]
    or  al,[is_abspub]
    jne wpef_seg_rel         ; either absolute segment or absolute public declaration

; check M bit for self-relative fixup
    mov al,BYTE PTR [locat]   ; get locat field low byte
    and al,40h              ; get M bit field value
;    je  wpef_self_rel        ; M bit reset, fixup self-relative
	jnz wpef_seg_rel
	;int3
    mov ax,INTERNAL_ERR     ; put warplink error code in ax
    mov cx, 49              ; internal error value
    jmp NEAR PTR link_error ; transfer control to error handler

; fixup segment relative
wpef_seg_rel:
    mov ax,[target_segment]
    xor bx,bx               ; bx:ax will hold byte value of target segment
    shl ax,1
    rcl bx,1                ; x2
    shl ax,1
    rcl bx,1                ; x4
    shl ax,1
    rcl bx,1                ; x8
    shl ax,1
    rcl bx,1                ; x16

; get target offset in bx:di
    mov di,WORD PTR [target_prog_off] ; get absolute offset low word
    sub di,ax               ; compute low word difference
    mov ax,bx
    mov bx,WORD PTR [target_prog_off+2]   ; get absolute offset high word
    sbb bx,ax               ; compute high word difference, with borrow
    ; jmp SHORT wpef_14        ; bypass self-relative fixup code

;ready to fixup the address
wpef_14:

%if 0
	push bx
; check if fixup overflow, bx should be 0 or 0ffffh (-64K >= offset <= 64K)
    inc bx
    cmp bx,1
    jbe wpef_14a             ; no fixup overflow

; check if possible lack of sign extension in data_offset vs. target_prog_off
    cmp bx,0ffffh
    jne wpef_fixwarn         ; bx not equal to -1

; lack of sign extension only if target_disp+2==0FFFFh
    mov ax,WORD PTR [target_disp+2]
    cmp ax,0ffffh
    je  wpef_14a             ; target_disp+2 == 0FFFFh

wpef_fixwarn:
    call    fixup_warning   ; yes, print warning message

wpef_14a:
	pop bx
%endif

	cmp	byte [compress_this],0		; see if compressing Clipper code
	je	wpef_notsymcomp		; no
	mov	ax,[current_segind]
	cmp	ax,[clipper_segindex]	; see if fixing up a SYMBOLS table during compression
	jne	wpef_notsymcomp		; not
;	call	compsym_fixup	; fixup of compressed symbols, modify data_rec_offset if compress
;	jc	wpef_out				; return carry flag set if throw away fixup
	stc
	mov ax, _WLCALC_EXT_NOT_FOUND_ERR
	jmp wpef_out

wpef_notsymcomp:
    mov ax, di               ; get 2-byte offset in ax
    mov dx, bx
	clc
; offset or loader-resolved offset
wpef_15a:
wpef_out:
    ret                     ; done


; compute frame for fixupp address
; use target data
; uses target_method,target_index memory variables
; can reset is_resolved memory variable flag
; return frame in memory variable target_segment
		; INP:	byte [target_method] = 6
		;	word [_wlcalc_pubdef] => PUB_DECLENT_STRUC
		;	word [_wlcalc_wrt_pointer] = -1 if no WRT clause parsed
		;	else:
		;	 dword [_wlcalc_wrt_pointer] -> dword WRT base
		;		(this is an executable image linear address that
		;		corresponds to the relative segment value to use)
		; OUT:	CY if not found,
		;	 ax = error code
		;	 if not found, _WLCALC_EXT_NOT_FOUND_ERR
		;	 if WRT clause parsed but absolute PUBDEF,
		;	  _WLCALC_ABS_WRT_ERR
		;	NC if found,
		;	 word [target_segment] = relative segment value for PUBDEF
		;	does not return if internal error occurs (44 to 49)
		; CHG:	ax, bx
		; STT:	ds => DGROUP
		; REM:	based on mlpass2d.nas get_frame_addr
_wlcalc_get_frame_addr:
    push    es              ; save critical register

wgfa_2:
    mov bl,[target_method]
		; target_method = 6
    and bl,3                ; mask off high bit to convert to segment/group/external value
		; bl = 2

wgfa_3:
	jmp wgfa_5

wgfa_spart_entry:
    test    BYTE PTR [es:15],80h    ; see if overlaid segment
    jne wgfa_overlaid        ; yes

    mov ax,[es:4]           ; get master segdef entry
    mov es,ax               ; es -> segdef entry

    test    BYTE PTR [es:28],1  ; see if segment if overlay class
    je  wgfa_3a              ; no
    cmp word [ovl_code_id],0       ; see if current L?DATA is owned by overlaid segment
    je  wgfa_3a              ; no
    cmp byte [nonovl_rvect],0      ; see if nonvector root calls flag set
    jne wgfa_3a              ; yes, bypass vectoring

; special case to allow accessing overlay class nonoverlaid code address from
; an overlaid segment.  If target displacement is nonzero then assume
; that the program really wants the address and not a vectored address.

    mov ax,WORD PTR [target_disp]
    or  ax,WORD PTR [target_disp+2]   ; see if nonzero target displacement
    jne wgfa_3a              ; yes

; if gen_flags bit 0 is set, then do no vector address changes
; Near/offset reference to different segment with no matching base references
; in fixup_ovl_extdef

    mov al,[gen_flags]
    and al,1                ; see if no vector address change flag set
    jne wgfa_3a              ; yes

; frame is overlay class within an overlaid segment
; or frame is an overlaid segment
; es -> segment partition entry
wgfa_overlaid:
wgfa_ret_not_found:
	mov ax, _WLCALC_EXT_NOT_FOUND_ERR
wgfa_ret_CY_ax:
	stc
	pop es
	retn

wgfa_3a:
    mov [frame_ent_ptr],ax    ; save pointer to frame entry
    mov ax,[es:2]           ; get low word of segment offset
    mov bx,[es:4]           ; get high word of segment offset
    shr bx,1
    rcr ax,1                ; /2
    shr bx,1
    rcr ax,1                ; /4
    shr bx,1
    rcr ax,1                ; /8
    shr bx,1
    rcr ax,1                ; /16, have paragraph value of offset (segment value)

wgfa_save_seg:
    mov [target_segment],ax   ; save to memory variable
    jmp SHORT wgfa_reloc

wgfa_group_entry:
    mov ax,es
    mov [frame_ent_ptr],ax    ; save pointer to frame entry
    mov ax,[es:0]           ; get low word of group offset
    mov bx,[es:2]           ; get high word of group offset
wgfa_wrt:
    shr bx,1
    rcr ax,1                ; /2
    shr bx,1
    rcr ax,1                ; /4
    shr bx,1
    rcr ax,1                ; /8
    shr bx,1
    rcr ax,1                ; /16, have paragraph value of offset (segment value)
    mov [target_segment],ax   ; save to memory variable

wgfa_reloc:
    mov al,1
    mov [is_relocatable],al   ; relocatable segment (assume group is always relocatable)
    pop es
    clc
    ret

; external index
wgfa_5:
	mov es, word [_wlcalc_pubdef]
				; es -> pubdef declarations entry
    or  BYTE PTR [es:14],40h    ; flag that used in fixup

    mov al,[es:14]          ; get definitions byte value
    and al,3                ; only keep pubdef/extdef/comdef/absolute field
    cmp al,2                ; check if unresolved external
    jb  wgfa_unres_ext       ; unresolved external
    ja  wgfa_abs             ; absolute public declaration

; pubdef declaration (not absolute)

	cmp word [_wlcalc_wrt_pointer], -1
	je @F
	les bx, [_wlcalc_wrt_pointer]
    mov ax,[es:bx + 0]           ; get low word of segment offset
    mov bx,[es:bx + 2]           ; get high word of segment offset
	jmp wgfa_wrt

@@:

; check if pubdef has a group associated with it
    mov al,[es:15]
    test    al,80h          ; high bit set if group associated with public declaration
    je  wgfa_6               ; no group

    and al,1                ; see if overlaid public
    jne wgfa_6               ; yes, flush group association

    mov al,1
    mov [frext_ingroup],al    ; flag external has associated group
    mov es,[es:2]           ; es -> group entry
    jmp SHORT wgfa_group_entry   ; perform code in common with group index

wgfa_6:
    xor al,al
    mov [frext_ingroup],al    ; flag external has no associated group
    mov es,[es:0]           ; es -> segment partition entry
    jmp NEAR PTR wgfa_spart_entry     ; external resolved, perform code in common with segment index

; absolute public declaration
wgfa_abs:
	mov ax, _WLCALC_ABS_WRT_ERR
	cmp word [_wlcalc_wrt_pointer], -1
	jne wgfa_ret_CY_ax
    xor ax,ax
    mov [is_relocatable],al   ; nonrelocatable segment
    mov [frame_ent_ptr],ax    ; zero frame entry pointer
    inc al
    mov [is_abspub],al        ; flag absolute public declaration
    mov ax,[es:2]           ; get frame number of public entry
    mov [target_segment],ax   ; save to target segment
    pop es
    clc
    ret

; unresolved external, no fixup
wgfa_unres_ext:
    mov byte [is_resolved],0       ; flag no fixup
	jmp wgfa_ret_not_found


; compute target program offset for fixupp address
; uses target_method,target_index,target_disp memory variables
; can reset is_resolved memory variable flag
		; INP:	name_field -> ASCIZ extern label name
		;	dword [target_disp] = displacement (always zero)
		;	word [_wlcalc_wrt_pointer] = -1 if no WRT clause parsed
		;	else: WRT clause parsed (exact value not used here)
		; CHG:	ax, bx
		; OUT:	CY if not found,
		;	 ax = error code
		;	 if not found, _WLCALC_EXT_NOT_FOUND_ERR
		;	 if WRT clause parsed but absolute PUBDEF,
		;	  _WLCALC_ABS_WRT_ERR
		;	NC if found,
		;	 word [_wlcalc_pubdef] => PUB_DECLENT_STRUC
		;	 dword [target_prog_off] = executable image linear address
		;	does not return if internal error occurs (44 to 49)
		; STT:	ds => DGROUP
		; REM:	based on mlpass2d.nas get_target_addr
_wlcalc_get_target_addr:
    push    es              ; save critical register

; external index, method 2 or 6
wgta_ext:
	push word [no_match_okay]
	mov byte [no_match_okay], 1
	mov di, name_field
	call find_pubdecl_entry
	pop word [no_match_okay]
	test ax, ax
	jz wgta_ret_not_found
	mov word [_wlcalc_pubdef], ax
    mov es, ax			; es -> pubdef declarations entry
    or  BYTE PTR [es:14],40h    ; flag that used in fixup
    mov [targ_ent_ptr],ax     ; save pointer to target entry
    test    BYTE PTR [es:15],1  ; see if public is overlaid
    je  wgta_2               ; no

	;int3
    mov ax,INTERNAL_ERR     ; put warplink error code in ax
    mov cx, 48              ; internal error value
    jmp NEAR PTR link_error ; transfer control to error handler

wgta_ret_not_found:
	mov ax, _WLCALC_EXT_NOT_FOUND_ERR
wgta_ret_CY_ax:
	stc
wgta_ret:
    pop es                  ; restore critical register
    ret

wgta_2:
    mov ax,WORD PTR [target_disp] ; get original target displacement
    add ax,[es:8]           ; add in offset of pubdef declarations entry
    mov WORD PTR [target_prog_off],ax ; update target program offset low word
    mov ax,WORD PTR [target_disp+2]
    adc ax,0                ; carry to high word
    mov WORD PTR [target_prog_off+2],ax   ; carry to target program offset high word

    test    BYTE PTR [es:15],1  ; see if overlaid public (referenced within same segment)
		; NC
    jne wgta_ret             ; yes, don't add in segment partition/sefdef offsets

    mov al,[es:14]          ; get definitions byte value
    and al,3                ; only keep pubdef/extdef/comdef field
    cmp al,2                ; check if unresolved external
    jb wgta_3                ; unresolved external

; external resolved, fixup okay
    cmp al,3                ; see if absolute public declaration
    je  wgta_4               ; yes

; pubdef, not absolute
    mov es,[es:0]           ; es -> segment partition entry
    test    BYTE PTR [es:15],80h    ; see if overlaid segment (local public with overlaid flag not set)
		; NC
    jne wgta_ret             ; yes, don't add in segment partition/sefdef offsets
    mov ax,[es:0]           ; get offset of segment partition entry
    add WORD PTR [target_prog_off],ax ; update target program offset low word
    adc WORD [target_prog_off+2],0    ; carry to target program offset high word
    mov ax,[es:4]           ; get master segdef entry from segment partition entry back pointer
    ; jmp NEAR PTR wgta_segdef_entry   ; do segdef entry offset addition

wgta_segdef_entry:
    mov es,ax               ; es -> master segdef entry
    mov ax,[es:2]           ; get low word of segment offset
    ; mov WORD PTR [lseg_canon],ax  ; save low word of offset for canonical computation
    add WORD PTR [target_prog_off],ax ; add to target program offset low word
    mov ax,[es:4]           ; get high word of segment offset
    ; mov WORD PTR [lseg_canon+2],ax    ; save high word of offset for canonical computation
    adc WORD PTR [target_prog_off+2],ax   ; add to target program offset high word with carry
    pop es
    clc
    ret

; unresolved external, no fixup
wgta_3:
    mov byte [is_resolved],0       ; flag no fixup
    jmp wgta_ret_not_found    ; exit without further processing

; absolute, no segment partition or segdef entry offsets
wgta_4:
	mov ax, _WLCALC_ABS_WRT_ERR
	cmp word [_wlcalc_wrt_pointer], -1
	jne wgta_ret_CY_ax
    xor ax,ax
		; NC
    mov [is_relocatable],al   ; nonrelocatable segment
    mov [targ_ent_ptr],ax     ; zero frame entry pointer
    inc al
    mov [is_abspub],al        ; flag absolute public declaration
    mov ax,[es:2]           ; get frame number in target_segment in case of LOC frame fixup
    mov [target_segment],ax
    pop es                  ; restore critical register
    ret


		; INP:	ds:si -> number
		; OUT:	CY if invalid,
		;	 ZR if overflow
		;	 NZ if invalid syntax
		;	NC if valid,
		;	 ds:si -> past number
		;	 dx:ax = number
		; CHG:	si, ax, bx, cx, dx
 global _wlcalc_parse_number
_wlcalc_parse_number:
	xor dx, dx
	db __TEST_IMM16		; skip mov dl
.decimalonly:
	mov dl, 1
		;	dl = 0 if to allow any supported base
		;	dl != 0 to allow only decimal
	lframe
	lenter
	 push dx
	lvar word, onlydecimal
	mov cx, 10
@@:
	mov bx, si
	lodsb
	cmp al, '_'
	je @B
	call ishex
	jc .invalid
	call .preloop
@@:
	dec si			; -> last byte
	cmp byte [si], '_'	; is it underscore ?
	je @B			; yes, strip it
	lodsb			; al = last byte, si -> past last byte
	call capitalise
	mov ah, al		; ah = al = suffix
	cmp al, 'H'
	jne @F
	mov cl, 16
	dec si			; decrease expected end
	jmp .gotbase

@@:
	mov al, [bx + 1]
	call capitalise		; al = prefix after zero

	cmp byte [bx], '0'	; zero ?
	jne @FF			; no --> (skip one @@)
	cmp al, 'B'
	jne @F
	inc bx
	inc bx			; increase pp
	mov cl, 2
	jmp .gotbase

@@:
	cmp al, 'X'
	jne @F
	inc bx
	inc bx			; increase pp
	mov cl, 16
	jmp .gotbase

@@:
	cmp ah, 'B'
	jne @F
	mov cl, 2
	dec si			; decrease expected end
.gotbase:
@@:
	xchg bx, si
	xor ax, ax
	 push ax
	 push ax
	lvar dword, number
.loop:
	cmp bx, si
	jbe .end
	lodsb
	cmp al, '_'
	je .loop
	call ishex
	jc .invalid
	cmp al, cl
	jae .invalid
	push ax
	mov ax, [bp + ?number]
	mul cx
	mov word [bp + ?number], ax
	xchg ax, dx
	xchg ax, word [bp + ?number + 2]
				; ?number = low word times base, ax = high word
	mul cx
	add word [bp + ?number + 2], ax
	jc .overflow
	test dx, dx
	jnz .overflow
	pop ax
	cbw
	add word [bp + ?number], ax
	adc word [bp + ?number + 2], dx
	jnc .loop
.overflow:
	cmp al, al
	stc
	jmp .ret

.invalid:
	or al, 1
	stc
	jmp .ret

.end:
	mov dx, word [bp + ?onlydecimal]
	call .preloop
	pop ax
	pop dx			; get ?number
	clc
.ret:
	lleave
	retn


.preloop:
	lodsb
	call capitalise
	cmp al, '_'
	je .preloop
	test dl, dl
	jz @F
	cmp al, '0'
	jb .retpre
	cmp al, '9'
	ja .retpre
@@:
	cmp al, 'X'
	je .preloop
	cmp al, 'H'
	je .preloop
	call ishex
	jnc .preloop
.retpre:
	dec si			; -> expected end
	retn


ishex:
	call capitalise
	sub al, '0'
	jc .ret
	cmp al, 10
	jb .ret_cmc
	sub al, 'A' - ('9' + 1)
	jc .ret
	cmp al, 10
	jb .ret
	cmp al, 16
.ret_cmc:
	cmc
.ret:
	retn


capitalise:
	cmp al, 'a'
	jb .gotcap
	cmp al, 'z'
	ja .gotcap
	xor al, 'A' ^ 'a'
.gotcap:
	retn


	lframe
	lemit off
	lvar word, do
	lvar word, size
	lequ 10, buffersize
	lvar ?buffersize, buffer
	lenter
	lvar dword, namepointer
	lvar word, pass
	lvar dword, repeat
	lvar dword, number

_wlcalc_do_seg: equ 0
_wlcalc_do_segrel: equ 1
_wlcalc_do_minussegrel: equ 2
_wlcalc_do_ext: equ 3
_wlcalc_do_minusext: equ 4
_wlcalc_do_extpara: equ 5
_wlcalc_do_minusextpara: equ 6
_wlcalc_do_opext: equ 7
_wlcalc_do_wrt: equ 8
_wlcalc_highest_seg_ext: equ 8

		; INP:	dx:ax = read from file, zero-extended (if not a dword)
		;	bx:cx = dword [?number] = constant read from the label
		; OUT:	CY to signal "overflow" (will error out)
		;	NC to not signal "overflow",
		;	 dx:ax = output (will be truncated if not a dword)
		; CHG:	ax, bx, cx, dx
		; REM:	The ?number variable may be re-used for repetition.
_wlcalc_do_div:
	test bx, bx
	jnz difficultdiv
	jcxz .error

	xchg bx, ax		; bx = low word
	xchg ax, dx
	xor dx, dx		; dx:ax = high word
	div cx
	xchg bx, ax		; bx = high word / divisor, ax = low word input
	div cx			; dx = remainder, ax = low word output
	mov dx, bx		; dx:ax = quotient

	db __TEST_IMM8		; skip stc, NC
.error:
	stc
	retn

difficultdiv:		; lDebug pick
.difficultdiv16:		; code adapted from Art of Assembly chapter 9
				; refer to http://www.plantation-productions.com/Webster/www.artofasm.com/DOS/ch09/CH09-4.html#HEADING4-99
	push bp
	push si
	push di
	mov bp, dx		; bp:ax = previous number
	mov dx, cx		; bx:dx = divisor
	xor di, di
	xor si, si		; clear variable si:di
	xchg ax, dx
	xchg bp, bx		; bx:dx = previous number, bp:ax = divisor
	mov cx, 32
.bitloop:
	shl dx, 1
	rcl bx, 1
	rcl di, 1
	rcl si, 1		; si:di:bx:dx << 1
	cmp si, bp		; does the divisor fit into si:di here ?
	jne @F
	cmp di, ax
@@:
	jb .trynext		; no -->
.goesinto:
	sub di, ax
	sbb si, bp		; subtract divisor
	inc dx			; set a bit of the result (bit was zero before, never carries)
.trynext:
	loop .bitloop		; loop for 32 bits
	pop di
	pop si
	pop bp			; bx:dx = quotient
	xchg ax, bx		; ax:dx = quotient
	xchg ax, dx		; dx:ax
	clc
	retn


_wlcalc_do_mul:
	push ax
	xchg ax, dx		; ax = high word in
	mul word [bp + ?number]	; dx:ax = high
	xchg cx, ax		; cx = high
	pop ax
%if 0
	test dx, dx		; > 32 bits ?
	stc			; CY
	jnz .ret		; yes -->
	mul word [bp + ?number]	; dx:ax = high
	add dx, bx		; CY if overflow
%endif

	mov bx, ax		; = low word
	mul word [bp + ?number]
	add cx, dx
	xchg ax, bx		; cx:bx = dword times low word, ax = low word
	mul word [bp + ?number + 2]
	add ax, cx		; ax:bx = dword times dword
	xchg bx, dx		; ax:dx
	xchg dx, ax		; dx:ax
	clc
.ret:
	retn


_wlcalc_do_shr:
	test bx, bx
	jnz _wlcalc_CY
@@:
	shr dx, 1
	rcr ax, 1
	loop @B
	clc
	retn


_wlcalc_do_shl:
	test bx, bx
	jnz _wlcalc_CY
@@:
	shl ax, 1
	rcl dx, 1
	loop @B
	clc
	retn


_wlcalc_do_xor:
	xor ax, cx
	xor dx, bx
	retn

_wlcalc_do_or:
	or ax, cx
	or dx, bx
	retn

_wlcalc_do_and:
	and ax, cx
	and dx, bx
	retn

_wlcalc_do_clr:
	not cx
	not bx
	and ax, cx
	and dx, bx
	retn


_wlcalc_do_add:
	add ax, cx
	adc dx, bx
	clc
	retn


_wlcalc_do_subr:
	xchg ax, cx
	xchg dx, bx
_wlcalc_do_sub:
	sub ax, cx
	sbb dx, bx
	clc
	retn

_wlcalc_CY:
	stc
	retn

_wlcalc_do_itoa:
	 push di
	 push si
	 push bx
	lframe 0, inner		; re-use existing stack frame
	lpar word, retn		; account for what's on the stack
	lpar word, di
	lpar word, si
	lpar word, bx
	lpar_return		; lleave will lea sp so it -> ?bx
	lenter

	test bh, bh		; unknown flag set ?
	jnz .error		; yes -->
	mov bh, '_'		; (NASM style)
	test bl, 1100b		; both bits clear ?
	jz @F
	mov bh, '.'		; (german)
	test bl, 1000b		; top bit clear ? (bottom bit must be set)
	jz @F
	mov bh, ','		; (english)
	test bl, 0100b		; bottom bit clear ? (top must be set)
	jz @F
	mov bh, "'"		; both bits are set (C23 style)
@@:
	shr bl, 1
	shr bl, 1
	shr bl, 1
	shr bl, 1		; bl = high nybble
	 push bx
	lvar word, separator_high_and_width_low
	lequ ?separator_high_and_width_low, width
	lequ ?separator_high_and_width_low + 1, separator
	mov bl, -1
	 push bx
	lvar word, counter

	cmp cl, 36
	ja .error
	cmp cl, 2
	jb .error
	cmp ch, 0		; no buffer size ?
	je @F			; yes -->
	cmp ch, ?buffersize	; in range ?
	ja .error		; no -->
	mov byte [bp + ?size], ch
				; change buffer size
@@:
	mov ch, 0
	testopt [bp + ?bx], 2	; flag zero fill ?
	mov bl, '0'		; fill with zero digits text
	jnz @F			; flag set, use zero fill -->
	mov bl, 32		; fill with blanks
@@:
	 push cx
	lea si, [bp + ?buffer]	; ss:si -> buffer start
	mov di, si		; ss:di -> buffer
	mov cx, word [bp + ?size]
@@:
	mov byte [ss:di], bl	; fill
	inc di
	loop @B			; ss:di -> behind buffer
	 pop cx			; base
.loop:
	cmp di, si
	jbe .error
	inc byte [bp + ?counter]; count up
	mov bx, word [bp + ?separator_high_and_width_low]
				; bl = width (counter limit), bh = separator
	test bl, bl		; want separators ?
	je @F			; no -->
	cmp bl, byte [bp + ?counter]
				; need one before next digit ?
	ja @F			; no -->
	mov byte [bp + ?counter], 0
				; reset counter
	dec di
	mov byte [ss:di], bh	; store separator
@@:
	cmp di, si		; di <= start of buffer ?
	jbe .error		; yes, overflow -->
	dec di			; -> digit buffer
	xchg bx, ax		; bx = low word
	xchg ax, dx		; ax = high word
	xor dx, dx		; dx:ax = high word
	div cx			; dx = remainder, ax = quotient word
	xchg bx, ax		; bx = quotient high word, ax = low word
	div cx			; dx = remainder, ax = quotient low word
	add dl, '0'		; dl = digit text if <= '9'
	cmp dl, '9'
	jbe @F
	add dl, 'A' - ('9' + 1)	; dl = digit text >= 'A'
@@:
	mov byte [ss:di], dl
	mov dx, bx		; dx:ax = quotient
	or bx, ax		; quotient nonzero ?
	jnz .loop		; yes -->

	mov bx, [bp + ?bx]
	test bl, 1		; flag padding after ?
	jz @F			; no -->
	mov cx, di
	sub cx, si		; = length of padding
	jz @F			; no padding, skip -->
.pushback:
	mov bx, word [bp + ?size]	; base = buffer size
	mov al, [bp + ?buffer]	; get first byte (padding)
.pushone:
	xchg al, [ss:si + bx - 1]
				; xchg (initially the last byte, then decrement)
	dec bx			; decrement
	jnz .pushone
	loop .pushback
@@:
	mov dx, word [bp + ?buffer + 2]
	mov ax, word [bp + ?buffer]
				; load buffer into registers for return
	db __TEST_IMM8		; skip stc, NC
.error:
	stc			; CY
	lleave			; lea sp -> ?bx
	pop bx
	pop si
	pop di			; restore registers
	retn

	lleave			; lemit off means this doesn't generate code


;*****************************
;* DUMP_OVL_FILE             *
;*****************************

; copy temporary overlay file to end of EXE file
; then close it and delete it
; upon entry bx== overlay file handle
; destroys ax,bx,cx,dx,si,di

dump_ovl_file   PROC
    xor cx,cx               ; move file pointer to start of file
    mov dx,cx
    mov ax,4202h            ; move file pointer, offset from file end
    int 21h
    call    restore_ems_map
    jc  dof_ovl_err         ; error in seek

    mov di,dx               ; save overlay file size high word
    mov si,ax               ; save overlay file size low word

    cmp byte [is_no_ems],0         ; see if EMS used
    jne dof_1               ; no

; EMS used, by definition it's okay to use physical page 0 for i/o buffer
    xor bx,bx
    mov al,bl
    call    map_ems_page    ; map page 0
%if 0 ;COMMENT #
    inc bx
    mov al,bl
    call    map_ems_page    ; map page 1
    inc bx
    mov al,bl
    call    map_ems_page    ; map page 2
    inc bx
    mov al,bl
    call    map_ems_page    ; map page 3
    mov ax,0fff0h
END COMMENT #
%endif

	mov	ax,16384
    mov [temp_buffer_size],ax ; keep size of temporary buffer
    mov ax,[ems_base]         ; use base of EMS memory as temporary base
    mov [temp_buffer_base],ax
    jmp SHORT dof_4a

dof_1:
    mov ah,48h              ; allocate memory
    mov bx,0ffffh           ; force request to fail, function will return largest available block
    int 21h
    cmp ax,8                ; insufficient memory error is expected
    je dof_2
    jmp NEAR PTR dos_error  ; other errors are fatal

dof_2:
    cmp bx,0fffh            ; check if more than 0fffh free paragraphs (64K-16 bytes)
    jbe dof_3               ; no
    mov bx,0fffh            ; allocate only up to 64K-16 for temporary disk write

dof_3:
    mov ax,bx
    shl ax,1                ; convert paragraphs allocated to bytes, x2
    shl ax,1                ; x4
    shl ax,1                ; x8
    shl ax,1                ; x16
    mov [temp_buffer_size],ax ; keep size of temporary buffer
    mov ah,48h              ; allocate memory
    int 21h
    jnc dof_4               ; should be successful, since using <= previous max value
    jmp NEAR PTR dos_error  ; any error is fatal

dof_4:
    mov [temp_buffer_base],ax ; save address of temporary buffer

dof_4a:
    mov bx,[ovl_handle]
    xor cx,cx               ; move file pointer to start of file
    mov dx,cx
    mov ax,4200h            ; move file pointer, offset from file start
    int 21h
    call    restore_ems_map
    jnc dof_5               ; no errors in seek

dof_ovl_err:
    mov dx,OFFSET ovl_filename wrt DGROUP
    jmp NEAR PTR dos_error  ; DOS file error

dof_5:
    or  di,di               ; see if byte count to write is 64K or more
    jne dof_6               ; yes, write a zero_block_size chunk
    cmp si,[temp_buffer_size] ; see if byte count is at least temp_buffer_size
    jb  dof_8               ; no, exit temp_buffer_size writing loop

dof_6:
    mov cx,[temp_buffer_size] ; number of bytes to read
    xor dx,dx               ; zero offset into buffer
    mov bx,[ovl_handle]
    mov ax,[temp_buffer_base]
    push    ds              ; save ds, critical register

	cmp	ax,[ems_base]			; see if reading to EMS
    mov ds,ax               ; ds -> segment to start write, DON'T MODIFY FLAGS
	jne	dof_fileread1		; no
	call	read_to_ems		; call read to EMS code
    pop ds                  ; restore ds -> warplink data
    jc  dof_ovl_err         ; error reading from file
	jmp	SHORT dof_readdone1

dof_fileread1:
    mov ah,3fh              ; read file
    int 21h
    call    restore_ems_map
    pop ds                  ; restore ds -> warplink data
to_dof_ovl_err_CY:
    jc  dof_ovl_err         ; error reading from file
	cmp ax, cx
	mov ax, -2		; short read code
	jne dof_ovl_err
dof_readdone1:

dof_6a:
    mov cx,[temp_buffer_size] ; number of bytes to write
    xor dx,dx               ; zero offset into buffer
    mov bx,[exe_handle]
    mov ax,[temp_buffer_base]
    push    ds              ; save ds, critical register
    mov ds,ax               ; ds -> segment to start write
    mov ah,40h              ; write to file
    int 21h
    call    restore_ems_map
    pop ds                  ; restore ds -> WarpLink data
    jnc dof_7               ; no errors

dof_exe_err:
    mov dx,OFFSET exe_name wrt DGROUP
    jmp NEAR PTR dos_error  ; error writing to file

dof_7:
    cmp ax, cx			; see if out of disk space
    je dof_7a              ; no

; out of disk space for executable file
dof_diskspace:
    mov ax,DISK_FULL_ERR
    mov dx,OFFSET exe_name wrt DGROUP
    jmp NEAR PTR link_error ; transfer to error handler

dof_7a:
    sub si,[temp_buffer_size] ; back off number of bytes written from bytes to write
    sbb di,0                ; borrow to high word
    jmp SHORT dof_5         ; loop for next write

; transfer leftover bytes (file size modulo temp_buffer_size)
dof_8:
    mov cx,si               ; cx holds bytes to write
    jcxz    dof_release     ; no bytes to write
    xor dx,dx               ; zero offset into buffer
    mov bx,[ovl_handle]
    mov ax,[temp_buffer_base]
    push    ds              ; save ds, critical register

	cmp	ax,[ems_base]			; see if reading to EMS
    mov ds,ax               ; ds -> segment to start write, DON'T MODIFY FLAGS
	jne	dof_fileread2		; no
	call	read_to_ems		; call read to EMS code
    pop ds                  ; restore ds -> warplink data
    jc  to_dof_ovl_err_CY	; error reading from file
	jmp	SHORT dof_readdone2

dof_fileread2:
    mov ah,3fh              ; read file
    int 21h
    call    restore_ems_map
    pop ds                  ; restore ds -> warplink data
    jc  to_dof_ovl_err_CY	; error reading from file
	cmp ax, cx
	mov ax, -2		; short read code
	jne dof_ovl_err
dof_readdone2:

    mov cx,si               ; cx holds bytes to write
    xor dx,dx               ; zero offset into buffer
    mov bx,[exe_handle]
    mov ax,[temp_buffer_base]
    push    ds              ; save ds, critical register
    mov ds,ax               ; ds -> segment to start write
    mov ah,40h              ; write to file
    int 21h
    call    restore_ems_map
    pop ds                  ; restore ds -> warplink data
    jc  dof_exe_err         ; error writing to file

    cmp ax, cx			; see if out of disk space
    jne  dof_diskspace        ; yes

; release temporary buffer back to dos
dof_release:
    cmp byte [is_no_ems],0         ; see if EMS used for i/o buffer
    je  dof_close           ; yes, no memory to release

    mov es,[temp_buffer_base]
    mov ah,49h              ; release memory
    int 21h
    jc  dof_exe_err         ; error occurred in memory release

; close temporary file
dof_close:
    mov bx,[ovl_handle]       ; get overlay file handle
    mov ah,3eh              ; close file
    int 21h
    call    restore_ems_map

; delete temporary overlay file
    mov dx,OFFSET ovl_filename wrt DGROUP
    mov ah,41h              ; delete file
    int 21h
    call    restore_ems_map
    ret
dump_ovl_file   ENDP

;*****************************
;* WRITE_BYTES               *
;*****************************

; write bytes to program's memory image
; upon entry [es:si] -> buffer to write from, cx == number of bytes to write,
; data_offset == offset from start of program
; updates si
; destroys ax,cx,di

write_bytes PROC
    push    ds              ; save critical register
    push    bp
    push    bx
    push    dx
    mov ax,[buffer_base]
    mov bx,es
    cmp bx,ax               ; see if write buffer is i/o buffer
    je  wb_is_io            ; yes
    mov ax,0ffffh           ; set to highest possible value so no overflow occurs
    jmp SHORT wb_set_bp

wb_is_io:
    mov ax,[buffer_end]

wb_set_bp:
    mov bp,ax               ; check only for end of physical buffer overflow

    cmp byte [is_clarion],0        ; see if clarion switch thrown
    je  wb_notcdata         ; no
    cmp word [ovl_data_id],0       ; see if clarion overlay data
    je  wb_notcdata         ; no
    call    write_clar_data ; write to .OVL file
    jmp NEAR PTR wb_ret     ; and return

wb_notcdata:
    cmp word [ovl_code_id],0       ; see if write is to an overlay
    je  wb_1                ; no
    call    ovl_file_write  ; write to .OVL file
    jmp NEAR PTR wb_ret     ; and return

wb_1:
    mov ax,WORD PTR [data_offset] ; get offset from program start in di:ax
    mov bx,ax               ; bx holds low word data offset
    mov di,WORD PTR [data_offset+2]
    mov dx,di               ; dx holds high word data offset
    add ax,cx               ; add in number of bytes to write
    adc di,0                ; carry to high word
    sub ax,1                ; adjust for number of bytes relative zero
    sbb di,0                ; borrow to high word

    cmp di,WORD PTR [highest_exe_write+2] ; compare to highest previous address write high word
    jb  wb_2                ; lower than previous address write
    ja  wb_new_high         ; higher than previous
    cmp ax,WORD PTR [highest_exe_write]   ; compare to highest previous address write low word
    jbe wb_2                ;  lower than or equal to previous

; update highest address write to new value
wb_new_high:
    mov WORD PTR [highest_exe_write],ax
    mov WORD PTR [highest_exe_write+2],di

    cmp di,WORD PTR [image_size+2]    ; check if attempt to write out of bounds
    jb  wb_2                ; no, in bounds
    ja  wb_bounds           ; yes, out of bounds
    cmp ax,WORD PTR [image_size]      ; check low word, high words are equal
    jb  wb_2                ; no, in bounds

; attempt to write out of bounds of program memory image
wb_bounds:
    mov dx,OFFSET filename wrt DGROUP
    mov ax,IMAGE_BOUNDS_ERR ; attempt to write data outside of program bounds
    jmp NEAR PTR error_read_buff_pos    ; transfer control to error handler

wb_2:
    cmp byte [is_ondisk],0         ; check if memory image is on disk
    je  wb_memory           ; no
    call    temp_file_write ; write bytes to temporary file (memory pages)
    jmp SHORT wb_ret        ; and return

wb_memory:
    mov di,bx               ; di has low word offset of data
    and di,15               ; di has normalized offset
    and bx,0fff0h           ; clear out normalized offset bytes
    mov ax,dx               ; ax has high word of data bytes offset
    xchg    ax,bx           ; high word in bx, low word in ax (w/o normalized offset bytes)

; convert bx:ax byte count to segment value in ax
    shr bx,1
    rcr ax,1                ; /2
    shr bx,1
    rcr ax,1                ; /4
    shr bx,1
    rcr ax,1                ; /8
    shr bx,1
    rcr ax,1                ; /16

; ax:di == normalized segment:offset of data offset

    add ax,[image_mem_ptr]    ; add in segment of memory image
    mov bx,es
    mov ds,bx               ; ds -> source buffer segment
    mov es,ax               ; es:di -> location in memory image to place data

    mov ax,si               ; get offset of source
    add ax,cx               ; add in number of bytes to write
    jc  wb_buff_wrap        ; overflow, buffer will wrap
    cmp ax,bp               ; see if past buffer end for total bytes written
    jbe wb_no_buff_wrap     ; no

wb_buff_wrap:
    mov dx,cx               ; save old byte count to write
    mov cx,bp               ; get buffer end
    sub cx,si               ; compute bytes to buffer end
    mov ax,cx               ; save byte count written this pass
    shr cx,1                ; convert byte count to write to words
    rep movsw               ; move the string
    rcl cx,1                ; pick up carry
    rep movsb               ; transfer leftover byte, if any
    xor si,si               ; wrap source offset to start of i/o buffer
    sub dx,ax               ; update total count, subtracting off byte count written
    mov cx,dx               ; get new total in cx

wb_no_buff_wrap:
    shr cx,1                ; convert byte count to write to words
    rep movsw               ; move the string
    rcl cx,1                ; pick up carry
    rep movsb               ; transfer leftover byte, if any

wb_endloop:
    mov es,bx               ; restore es -> source buffer

wb_ret:
    pop dx                  ; restore critical register
    pop bx
    pop bp
    pop ds
    ret
write_bytes ENDP

;*****************************
;* UPDATE_GRP_OFF            *
;*****************************

; make group offset the lowest address of the segments in the group
; upon entry es -> segdef entry
; destroys ax

update_grp_off  PROC
    push    ds              ; save critical register
    mov ax,[es:16]          ; get pointer to group entry
    mov ds,ax               ; ds -> group entry
    mov ax,[es:4]           ; get segment offset high word
    cmp ax,[2]           ; compare to group offset high word
    ja  ugo_ret             ; segment offset higher than group offset
    jb  ugo_2               ; segment offset lower, update group offset
    mov ax,[es:2]           ; get segment offset low word
    cmp ax,[0]           ; compare to group offset low word
    jae ugo_ret             ; segment offset higher or equal to group offset

ugo_2:
    mov ax,[es:4]           ; get high word
    mov [2],ax           ; update group offset high word
    mov ax,[es:2]           ; get low word
    mov [0],ax           ; update group offset low word
    mov ax,es
    mov [8],ax           ; save segdef entry pointer of lowest segment

ugo_ret:
    pop ds                  ; restore critical register
    ret
update_grp_off  ENDP

;*****************************
;* GET_CLASS_TYPE            *
;*****************************

; get type of segment class for DOSSEG segment ordering
; type == 0 for segment class CODE
;      == 1 for other segments outside of DGROUP
;      == 2 for DGROUP segment class BEGDATA
;      == 3 for DGROUP segment class not equal to BEGDATA, BSS, or STACK
;      == 4 for DGROUP segment class BSS
;      == 5 for DGROUP segment class STACK
; classes are not case sensitive for type (but are for concatenation)
; a suffix of the class name establishes type, e.g. BC_CODE is class CODE
; upon entry ds:si -> class name, es -> warplink data,
;  bx holds segment of segdef entry
; returns class type in al
; destroys ax,cx

get_class_type  PROC
    push    es              ; save critical register
    push    ds
    push    di
    push    bx

	push	es
	push	ds
	pop	es
	pop	ds					; ds -> warplink data, es:si -> class name
    xor cx,cx               ; cx will hold string char count
    mov bx,si               ; bx -> class name

gct_count_loop:
    cmp BYTE PTR [es:bx],0  ; see if at end of string
    je  gct_code_chk        ; yes
    inc cx                  ; bump count of chars
    inc bx                  ; bump char slot
    jmp SHORT gct_count_loop    ; loop to check next char

gct_code_chk:
    cmp cx,4                ; see if possible class CODE
    jb  gct_nodgroup_chk    ; no, name string too small
    mov di,cx               ; di will offset into end of string
    sub di,4                ; bx+di -> last four chars of string
    mov bx,si               ; bx -> class name
    add bx,di               ; bx -> last four chars of string
    mov di,OFFSET codetext wrt DGROUP   ; di -> target string
    call    caseless_strcmp ; see if strings match
    or  al,al               ; check return value
    jne gct_nodgroup_chk    ; nonzero return value, string didn't match
    jmp NEAR PTR gct_ret    ; return al == 0 for class CODE

; see if segment is NOT in group DGROUP
gct_nodgroup_chk:
    mov di,es               ; save es -> class name string
    pop es                  ; es -> segdef entry
    push    es              ; restore value to stack
    mov ax,[es:16]          ; get group entry segment, if any
    or  ax,ax               ; check if entry exists
    jne gct_2               ; yes

; no group exists for this segment, not in group DGROUP
gct_not_dgroup:
    mov al,1                ; return al ==1 for segment not in DGROUP
    jmp NEAR PTR gct_ret

gct_2:
    mov es,ax               ; es -> group entry
    mov bx,[es:4]           ; get group name offset in bx
    mov es,[es:6]           ; es:bx -> group name
    add bx,8                ; adjust past two doubleword pointers

; simple-minded check for group DGROUP, case sensitive
    cmp BYTE PTR [es:bx],'D'    ; check first char
    jne gct_not_dgroup      ; doesn't match
    cmp BYTE PTR [es:bx+1],'G'  ; check remaining chars
    jne gct_not_dgroup
    cmp BYTE PTR [es:bx+2],'R'
    jne gct_not_dgroup
    cmp BYTE PTR [es:bx+3],'O'
    jne gct_not_dgroup
    cmp BYTE PTR [es:bx+4],'U'
    jne gct_not_dgroup
    cmp BYTE PTR [es:bx+5],'P'
    jne gct_not_dgroup
    cmp BYTE PTR [es:bx+6],0  
    jne gct_not_dgroup

; segment is a member of group DGROUP
    mov es,di                   ; restore es -> class name

; see if segment is class BEGDATA
gct_begdata_chk:
    cmp cx,7                ; see if possible class BEGDATA
    jb  gct_bss_chk         ; no, name string too small
    mov di,cx               ; di will offset into end of string
    sub di,7                ; bx+di -> last seven chars of string
    mov bx,si               ; bx -> class name
    add bx,di               ; bx -> last seven chars of string
    mov di,OFFSET begdatatext wrt DGROUP    ; di -> target string
    call    caseless_strcmp ; see if strings match
    or  al,al               ; check return value
    jne gct_bss_chk         ; nonzero return value, string didn't match
    mov al,2                ; return al == 2 for class BEGDATA
    jmp SHORT gct_ret

; see if segment is class BSS
gct_bss_chk:
    cmp cx,3                ; see if possible class BSS
    jb  gct_stack_chk       ; no, name string too small
    mov di,cx               ; di will offset into end of string
    sub di,3                ; bx+di -> last three chars of string
    mov bx,si               ; bx -> class name
    add bx,di               ; bx -> last three chars of string
    mov di,OFFSET bsstext wrt DGROUP    ; di -> target string
    call    caseless_strcmp ; see if strings match
    or  al,al               ; check return value
    jne gct_stack_chk       ; nonzero return value, string didn't match
    mov al,4                ; return al == 4 for class BSS
    jmp SHORT gct_ret

; see if segment is class STACK
gct_stack_chk:
    cmp cx,5                ; see if possible class STACK
    jb  gct_other           ; no, name string too small
    mov di,cx               ; di will offset into end of string
    sub di,5                ; bx+di -> last five chars of string
    mov bx,si               ; bx -> class name
    add bx,di               ; bx -> last five chars of string
    mov di,OFFSET stacktext wrt DGROUP  ; di -> target string
    call    caseless_strcmp ; see if strings match
    or  al,al               ; check return value
    jne gct_other           ; nonzero return value, string didn't match
    mov al,5                ; return al == 5 for class STACK
    jmp SHORT gct_ret

; segment is in DGROUP but does NOT have class BEGDATA, BSS, or STACK
gct_other:
    mov al,3                ; resturn al == 3 for non- BEGDATA, BSS, and STACK DGROUP segment

gct_ret:
    pop bx                  ; restore critical register
    pop di
    pop ds
    pop es
    ret
get_class_type  ENDP

;*****************************
;* CASELESS_STRCMP           *
;*****************************

; caseless string compare, upper and lowercase chars match 
; checks string -> by es:bx against string -> by ds:di
; returns al == 0 is match, al == 1 is no match
; destroy ax,bx,di

caseless_strcmp PROC
cs_comp_loop:
    mov al,[es:bx]          ; get char
    or  al,al               ; if zero then at end of strings
    jne cs_2                ; not done with string compare
    or  al,[di]             ; merge in second string char, still zero (successful match) if both terminated
    jne cs_nomatch          ; not zero, flag unsuccessful match
    ret

cs_2:
    cmp al,'a'              ; check lowercase lower bound
    jb  cs_3                ; no
    cmp al,'z'              ; check lowercase upper bound
    ja  cs_3                ; no
    sub al,20h              ; convert to uppercase

cs_3:
    mov ah,[di]             ; get target string char
    cmp ah,'a'              ; check lowercase lower bound
    jb  cs_4                ; no
    cmp ah,'z'              ; check lowercase upper bound
    ja  cs_4                ; no
    sub ah,20h              ; convert to uppercase

cs_4:
    cmp al,ah               ; see if chars match
    jne cs_nomatch          ; no
    inc bx                  ; this char matches, try next char in string
    inc di
    jmp SHORT cs_comp_loop  ; loop till string complete

cs_nomatch:
    mov al,1                ; flag unsuccessful compare
    ret
caseless_strcmp ENDP

		; INP:	cx = length
		;	es => buffer
		; CHG:	ax, cx
check_com_cut:
	push di
	xor ax, ax
	push cx
	xor di, di
	repe scasb
	pop cx
	je .nowarn
	mov al, 90h
	xor di, di
	repe scasb
	je .nowarn

	push dx
    mov dx,OFFSET exe_name wrt DGROUP
    mov ax,COM_PREFIX_UNKNOWN_WARN
    call    link_warning
	pop dx
.nowarn:
	pop di
	retn


END
