;*****************************************************************************
;  Scheme 8088 code vectors      BODY CODE OBJECTS     cvect2.ss 2/22/92
;  (%make-code-vector n)
;  (asm-p1-string [a1] [a2])   create/add-string/get  CVO
;  (%code-vector-ref v i)
;  (%code-vector-set! v i d)   v=vector i=index d=data
;  (list->cvector l)
;*****************************************************************************
   ((sp #x2c load.lco)

    .align-para
    (l load.lco)        ; lambda code object header
    (iw #x3c00)
    (aw load.size)
    (aw load.start)
    (ag load.lco)
    (iw #x0800)
    (iw 10)                   ; number externs *****************************
    (sp #x24 name.mkcv)
    (sp #x28 mkcv.bco)
    (sp #x24 name.a1)
    (sp #x28 a1.bco)
    (sp #x24 name.cvr)
    (sp #x28 cvr.bco)
    (sp #x24 name.cvs!)
    (sp #x28 cvs!.bco)
    (sp #x24 name.l->cv)
    (sp #x28 l->cv.bco)

    (dl load.start load.lco)
    (push es)
    (push di)
    (push bp)
    (mov iw ax) (iw #x0f00)
    (push ax)
    (push cs)                      ; closure for loading
    (mov iw ax) (aw load.body)
    (push ax)
    (mov iw ax) (iw 1)
    (int #x98)
    
    (dl load.body load.lco)        ; body:   (set! G?? <bco>) ...
    (and ax ax)
    (jz) (db load.body.arg.ok)
    (mov ib dl) (ib 1)
    (int #x90)
    
    (l load.body.arg.ok)
    (mov iw si) (iw 12)
    (mov iw cx) (iw 5)            ; number of set!'s *******************
    (l load.loop)
    (cs:) (lds (si w) bx)          ; DS:BX = untagged to symbol
    (xor bh bh)
    (cs:) (mov (db si w) ax) 4     ; set! symbol = BCO
    (mov ax (bx w))
    (cs:) (mov (db si w) ax) 6
    (mov ax (bx db w)) 2
    (add ib si) 8
    (loop) (db load.loop)

    (xor ax ax)
    (mov ax ds)
    (pop bp) (pop bp)
    (pop di) (pop es)
    (retf)
    (dl load.size load.lco)
    
    (l name.mkcv)
    (ss "%make-code-vector")
    (l name.a1)
    (ss "asm-p1-string")
    (l name.cvr)
    (ss "%code-vector-ref")
    (l name.cvs!)
    (ss "%code-vector-set!")
    (l name.l->cv)
    (ss "list->cvector")

;*****************************************************************************
;  body code object for  %make-code-vector
;*****************************************************************************
;  (()
    .align-para
    (l mkcv.bco)        ; body code object header
    (iw #x3800)
    (aw mkcv.size)
    (aw mkcv.start)
    (ag mkcv.bco)
    (iw #x0800)
    (iw #x0000)
    
    (dl mkcv.start mkcv.bco)
    (push es)                    ; save CP & FP
    (push di)
    (push bp)
    (mov iw bx) (iw #x0f00)
    (push bx)
;  
    (mov sp bp)                  ; bound var base
    (cmp iw ax) (iw 1)           ; check number args = 1
    (jz) (db mkcv.arg.ck)
    (mov ib dl) 1
    (int #x90)

    (l mkcv.arg.ck)
    (ss:) (lds (bp db w) ax) 12  ; DS:AX = arg1
    (cmp ib ah) #x08             ; fixnum?
    (jz) (db mkcv.arg.ck2)
    (mov ib dl) 7
    (int #x90)
    
    (l mkcv.arg.ck2)
    (mov ds ax)
    (cmp iw ax) (iw 64000)        ; <= 64000
    (jna) (db mkcv.arg.ok)
    (mov ib dl) 10
    (int #x90)
;
;  check space in heap
;    
    (l mkcv.arg.ok)      ; AX = byte size of CVO
    (add iw ax) (iw 19)  ; add 4 for header, 15 to round up
    (mov ib cl) 4        ; divide by 16
    (inc ax)             ; add 1 para for 000C alignment
    (shr cl ax)          ; AX = number paras needed

    (int #x96)         ; space check and gc call   ES:DI = allocation ptr
;
;  allocate code vector
;
    (mov iw di) (iw #x000c)      ; align ES:DI to 4 byte less than paragraph
    (mov di dx)                  ; DX = type & offset CVO
    (mov ib dh) #x6c
    (cld)
    (mov iw ax) (iw #x7c00)      ; CVO header
    (stos.w)
    (ss:) (mov (bp db w) ax) 14  ; arg1 size
    (stos.w)
    (add iw ax) (iw 3)   ; add 3 to round up
    (shr ax)       ; /4
    (shr ax)       ; AX = long size
    (add ax ax)
    (mov ax cx)    ; CX = word size
    (xor ax ax)
    (stos.w cx)    ; store cx 0 words (CVO size 0 bytes)
    
    (mov es ax)    ; DS:AX = new CVO
    (mov ax ds)
    (mov dx ax)
;
;  update free space pointer
;    
    (int #x97)            ; allocation ptr = adjusted ES:DI
        
    (pop bp)              ; restore CP & FP
    (pop bp)
    (pop di)
    (pop es)
    (retaf) (iw 4)        ; kill args

    (dl mkcv.size mkcv.bco)

;*****************************************************************************
;  body code object for  asm-p1-string 
;  (asm-p1-string)     return local CVO
;  (asm-p1-string n)   n=fixnum  create new cvo length n    returns new CVO
;  (asm-p1-string s)   s=string  add string s to cvo
;  (asm-p1-string s i) s=string i=index  replace @ index with string
;  (asm-p1-string c)   c=char    add char c to cvo
;  (asm-p1-string #f)  return index
;  global %asm-p1-code-index
;*****************************************************************************
;  (()
    .align-long
    (l a1.index)
    (ss "%asm-p1-code-index")

    .align-para
    (l a1.bco)        ; body code object header
    (iw #x3800)
    (aw a1.size)
    (aw a1.start)
    (ag a1.bco)
    (iw #x0800)
    (iw #x0002)
    (iw 0)       ; local CVO  (code vector object)
    (iw 0)
    (sp #x24 a1.index)
;
;  CVO expanding flag
;  0 = new CVO
;  1 = adding on with string or char               
;
    (dl a1.expand.flag a1.bco) 0
    
    (dl a1.start a1.bco)
    (push es)                    ; save CP & FP
    (push di)
    (push bp)
    (mov iw bx) (iw #x0f00)
    (push bx)
    (xor bl bl)
    (cs:) (mov bl (dw b)) (aw a1.expand.flag)  ; reset flag for CVO expand

;-------------------------------------------------------
;  if 0 args then return CVO
;-------------------------------------------------------
    (mov sp bp)                  ; bound var base
    (and ax ax)
    (jnz) (db a1.2arg)

    (cs:) (lds (dw w) ax) (iw 12); DS:AX = local CVO
    (cmp ib ah) #x6c
    (jnz) (db a1.0arg.ret)       ; return #f if no local CVO
    
    (mov ax bx)
    (xor bh bh)                  ; DS:BX = untagged to cvo
    (cs:) (les (dw w) cx) (iw 16); ES:DI = global index
    (xor ch ch)
    (mov cx di)
    (es:) (mov (di db w) cx) 2      ; get CVO index
    (mov cx (db bx w)) 2         ; CVO size = CX
    (xor bx bx)
    (cs:) (mov bx (dw w)) (iw 12); set! local CVO to #f
    (cs:) (mov bx (dw w)) (iw 14)

    (l a1.0arg.ret)
    (pop bp)              ; restore CP & FP
    (pop bp)
    (pop di)
    (pop es)
    (retaf) (iw 0)
;-------------------------------------------------------
;  check for 2 args  
;-------------------------------------------------------
    (l a1.2arg)
    (cmp iw ax) (iw 2)           ; check number args = 2
    (jnz) (db a1.1arg)
    (mov sp bp)                  ; bound var base
    (ss:) (lds (bp db w) ax) 16  ; DS:AX = arg1
    (cmp ib ah) #x20             ; string?
    (jz) (db a1.arg2.ck)
    (mov ib dl) 122
    (int #x90)

    (l a1.arg2.ck)
    (xor ah ah)      ; DS:SI = untagged to string
    (mov ax si)
    (ss:) (mov (bp db w) ax) 12  ; AX = arg2 tag
    (cmp ib ah) #x08             ; fixnum?
    (jz) (db a1.arg2.ok)
    (mov ib dl) 7
    (int #x90)
    
    (l a1.arg2.ok) 
    (mov (bp db w) bx) 14          ; BX = index
    (mov (si db w) cx) 2           ; CX = arg1 string length
    (add ib si) 4                  ; DS:SI = untagged to 1st char arg1
    (cs:) (les (dw w) ax) (iw 12)  ; ES:AX = local CVO
    (cmp ib ah) #x6c
    (jnz) (db a1.2arg.ret)         ; return #f if no local CVO
    (xor ah ah)                    ; ES:DI = untagged local CVO
    (mov ax di)
    (es:) (mov (di db w) dx) 2     ; DX = CVO length
    (add ib di) 4                  ; ES:DI = untagged to 1st byte CVO
    (mov bx ax)
    (add cx ax)
    (cmp dx ax)
    (jna) (db a1.index.ok)
    (mov ib dl) 11
    (int #x90)
    
    (l a1.index.ok)
    (add bx di)           ; ES:DI = untagged to 1st byte to replace
    (cld)
    (movs.b cx)

    (xor ax ax)           ; return #t
    (mov ax ds)
    (dec al)
    (jmps) (db a1.2arg.end)

    (l a1.2arg.ret)
    (xor ax ax)           ; return #f
    (mov ax ds)
    
    (l a1.2arg.end)
    (pop bp)              ; restore CP & FP
    (pop bp)
    (pop di)
    (pop es)
    (retaf) (iw 8)        ; kill args

;-------------------------------------------------------
;  check for 1 arg  
;-------------------------------------------------------
    (l a1.1arg)
    (cmp iw ax) (iw 1)           ; check number args = 1
    (jz) (db a1.arg.ck)
    (mov ib dl) 1
    (int #x90)
;-------------------------------------
;  check arg1 for string
;-------------------------------------
    (l a1.arg.ck)
    (l a1.again)
    (mov sp bp)                  ; bound var base
    (ss:) (lds (bp db w) ax) 12  ; DS:AX = arg1
    (cmp ib ah) #x20             ; string?
    (jnz) (db a1.arg.ckc)
;
;  arg1 is string   copy string to local CVO
;    
    (xor ah ah)
    (mov ax si)              ; DS:SI = untagged to string
    (mov (si db w) cx) 2     ; CX = string length

    (add ib si) 4            ; DS:SI = untagged to 1st char in string
    (and cx cx)
    (jz) (db a1.zstr)
    
    (cs:) (les (dw w) ax) (iw 16)  ; ES:DI = untagged to global index
    (xor ah ah)
    (mov ax di)
    (es:) (mov (di db w) bx) 2        ; BX = CVO index
    (cs:) (les (dw w) ax) (iw 12)  ; ES:AX = local CVO
    (cmp ib ah) #x6c
    (jnz) (db a1.1arg.ret)         ; return #f if no local CVO
    (xor ah ah)                    ; ES:DI = untagged local CVO
    (mov ax di)
    (es:) (mov (di db w) dx) 2     ; DX = CVO length
    (add ib di) 4
    (add bx di)                    ; ES:DI = unttagged to first empty byte
    
    (add cx bx)              ; BX = new index (after adding string)
    (cmp dx bx)              ; check for CVO overflow
    (ja) (db a1.str.over)
    (cld)
    (movs.b cx)              ; copy string to CVO
    (cs:) (les (dw w) ax) (iw 16)  ; ES:DI = untagged to global index
    (xor ah ah)
    (mov ax di)
    (es:) (mov bx (di db w)) 2        ; update index
    
    (l a1.zstr)
    (xor ax ax)             ; return #t
    (mov ax ds)
    (dec al)
    (jmp) (dw a1.end)
;-------------------------------------
;  string or char overflows CVO
;-------------------------------------
    (l a1.str.over)
    (cs:) (inc (dw b)) (aw a1.expand.flag)  ; set flag for CVO expand
    (mov dx ax)             ; AX = 2 * local CVO length
    (add ax ax)             
    (jnz) (db a1.go.limit.ck)  ; allocate a new CVO 2 times as big
    (inc ax)
    (l a1.go.limit.ck)
    (jmp) (dw a1.limit.ck)  ; allocate a new CVO
;-------------------------------------
;  return #f  for no local CVO
;-------------------------------------
    (l a1.1arg.ret)       ; return #f if no local CVO
    (xor ax ax)
    (mov ax ds)
    (jmp) (dw a1.end)
;-------------------------------------
;  check arg1 for char
;-------------------------------------
    (l a1.arg.ckc)
    (ss:) (lds (bp db w) ax) 12  ; DS:AX = arg1
    (cmp ib ah) #x06             ; string?
    (jnz) (db a1.arg.ckf)
;
;  arg1 is char   copy char to local CVO
;
    (mov ds cx)              ; CX = char

    (cs:) (les (dw w) ax) (iw 16)  ; ES:DI = untagged to global index
    (xor ah ah)
    (mov ax di)
    (es:) (mov (di db w) bx) 2        ; BX = CVO index
    (cs:) (les (dw w) ax) (iw 12)  ; ES:AX = local CVO
    (cmp ib ah) #x6c
    (jnz) (db a1.1arg.ret)         ; return #f if no local CVO
    (xor ah ah)                    ; ES:DI = untagged local CVO
    (mov ax di)
    (es:) (mov (di db w) dx) 2     ; DX = CVO length
    (add ib di) 4
    (add bx di)                    ; ES:DI = unttagged to first empty byte
    
    (add iw bx) (iw 1)             ; BX = new index (after adding char)
    (cmp dx bx)                    ; check for CVO overflow
    (ja) (db a1.str.over)
    (cld)
    (es:) (mov cl (di b))          ; copy char to CVO
    (cs:) (les (dw w) ax) (iw 16)  ; ES:DI = untagged to global index
    (xor ah ah)
    (mov ax di)
    (es:) (mov bx (di db w)) 2        ; update index
    
    (xor ax ax)             ; return #t
    (mov ax ds)
    (dec al)
    (jmp) (dw a1.end)
;-------------------------------------
;  check for #f   then return index
;-------------------------------------
    (l a1.arg.ckf)
    (cmp ib ah) #x00            ; #f
    (jnz) (db a1.arg.ckx)

    (cs:) (les (dw w) ax) (iw 12)  ; ES:AX = local CVO
    (cmp ib ah) #x6c
    (jnz) (db a1.1arg.ret)       ; return #f if no local CVO

    (cs:) (les (dw w) ax) (iw 16)  ; ES:DI = untagged to global index
    (xor ah ah)
    (mov ax di)
    (es:) (mov (di db w) ax) 2        ; AX = CVO index
    (mov ax ds)
    (mov iw ax) (iw #x0800)
    (jmp) (dw a1.end)
;-------------------------------------
;  check for fixnum    then create new CVO
;-------------------------------------
    (l a1.arg.ckx)
    (cmp ib ah) #x08             ; fixnum?
    (jz) (db a1.arg.ck2)
    (int #x95)
    (mov ib dl) 7
    (int #x90)
    
    (l a1.arg.ck2)
    (mov ds ax)
    
    (l a1.limit.ck)
    (cmp iw ax) (iw 64000)        ; <= 64000
    (jna) (db a1.arg.ok)
    (mov ib dl) 10
    (int #x90)
;
;  check space in heap
;    
    (l a1.arg.ok)        ; AX = size of new CVO
    (mov ax bp)          ; BP = size of new CVO  (dummy FP)
    (add iw ax) (iw 19)  ; add 4 for header, 15 to round up
    (mov ib cl) 4        ; divide by 16
    (inc ax)             ; add1 para for 000C alignment
    (shr cl ax)          ; AX = number paras needed

    (int #x96)           ; space check and gc call   ES:DI = allocation ptr
;
;  allocate code vector
;
    (mov iw di) (iw #x000c)      ; align ES:DI to 4 byte less than paragraph
    (mov di dx)                  ; DX = type & offset CVO
    (mov ib dh) #x6c
    (cld)
    (mov iw ax) (iw #x7c00)      ; CVO header
    (stos.w)
    (mov bp ax)     ; size of new CVO
    (stos.w)
    (add iw ax) (iw 3)   ; add 3 to round up
    (shr ax)       ; /4
    (shr ax)       ; AX = long size
    (add ax ax)
    (mov ax cx)    ; CX = word size
    (xor ax ax)
    (stos.w cx)    ; store cx 0 words (CVO size 0 bytes)
    

    (int #x97)     ; update allocation ptr 
;
;  If expand flag set & local CVO exists then copy local CVO to new CVO
;  ES:DX = new CVO   
;   
    (cs:) (mov (dw b) al) (aw a1.expand.flag)  ; get flag for CVO expand
    (and al al)
    (jz) (db a1.no.expand)
    (cs:) (lds (dw w) ax) (iw 12)  ; DS:SI = untagged local CVO
    (cmp ib ah) #x6c
    (jz) (db a1.cvo.copy)
    
    (l a1.no.expand)
    (push es)
    (push di)
    (cs:) (les (dw w) ax) (iw 16)  ; ES:DI = untagged to global index
    (xor ah ah)
    (mov ax di)
    (xor ax ax)
    (es:) (mov ax (di db w)) 2         ; set! index = 0
    (mov iw ax) (iw #x0800)
    (es:) (mov ax (di db w)) 0
    (pop di)
    (pop es)
    (jmps) (db a1.no.cvo.copy)
;
;  local CVO exists
;
    (l a1.cvo.copy)
    (xor ah ah)
    (mov ax si)
    (push es)
    (push di)
    (cs:) (les (dw w) ax) (iw 16)  ; ES:DI = untagged to global index
    (xor ah ah)
    (mov ax di)
    (es:) (mov (di db w) cx) 2         ; CX = index
    (pop di)
    (pop es)

    (and cx cx)
    (jz) (db a1.no.cvo.copy)
    (add ib si) 4                  ; DS:SI = untagged local CVO
    (mov dx ax)                    ; ES:DI = untagged new CVO
    (xor ah ah)
    (mov ax di)
    (es:) (mov (di db w) bx) 2     ; BX = new CVO length
    (cmp bx cx)                    ; check new is longer than local
    (jb) (db a1.cvo.copy.ok)
    (mov bx ds)
    (mov iw ax) (iw #x0800)
    (int #x95)
    (mov iw ax) (iw 32)
    (mov ax ds)
    (mov iw ax) (iw #x0600)
    (int #x95)
    (mov cx ds)
    (mov iw ax) (iw #x0800)
    (int #x95)
    (mov ib dl) 254
    (int #x90)
    
    (l a1.cvo.copy.ok)
    (add ib di) 4
    (cld)
    (movs.b cx)                    ; copy local to new
;    
;  update local CVO    
;    
    (l a1.no.cvo.copy)
    (cs:) (mov es (dw w)) (iw 14)   ; set! local CVO = new CVO
    (cs:) (mov dx (dw w)) (iw 12)
;
;  if expand flag then try copy string/char again    
;    
    (cs:) (mov (dw b) al) (aw a1.expand.flag)  ; AL = flag for CVO expand
    (and al al)
    (jz) (db a1.ret.cvo)
    (jmp) (dw a1.again)
;
;  else return CVO    
;    
    (l a1.ret.cvo)
    (mov es ax)           ; return new CVO
    (mov ax ds)
    (mov dx ax)
    
    (l a1.end)
    (pop bp)              ; restore CP & FP
    (pop bp)
    (pop di)
    (pop es)
    (retaf) (iw 4)        ; kill args

    (dl a1.size a1.bco)

;*****************************************************************************
;  body code object for code-vector-ref
;*****************************************************************************
    .align-para
    (l cvr.bco)        ; body code object header
    (iw #x3800)
    (aw cvr.size)
    (aw cvr.start)
    (ag cvr.bco)
    (iw #x0800)
    (iw #x0000)
    
    (dl cvr.start cvr.bco)

    (cmp iw ax) (iw 2)           ; check number args = 2
    (jz) (db cvr.arg.ck)
    (mov ib dl) 1
    (int #x9f)

    (l cvr.arg.ck)               ; DS:AX = 1st arg 
    (mov sp bx)
    (ss:) (lds (bx db w) ax) 8
    (cmp ib ah) #x6c             ; check for code vector
    (jz) (db cvr.arg.cv)
    (mov ib dl) 221
    (int #x9f)
   
    (l cvr.arg.cv)
    (xor ah ah)
    (mov ax si)                  ; DS:SI = untagged to code vector
    (ss:) (mov (bx db w) ax) 4   ; AX = type of 2nd arg
    (cmp ib ah) #x08             ; check for fixnum
    (jz) (db cvr.arg.fx)
    (mov ib dl) 7
    (int #x9f)
   
    (l cvr.arg.fx)
    (ss:) (mov (bx db w) cx) 6   ; CX = arg 2
    (mov (si db w) ax) 2         ; AX = code vector size
    (cmp ax cx)
    (jb) (db cvr.arg.rok)
    (mov ib dl) 11
    (int #x9f)
   
    (l cvr.arg.rok)
    (add cx si)                  ; DS:SI = untagged to byte in cv
    (add ib si) 4
    (mov (si b) al)              ; AL = byte from cv
    (xor ah ah)                  ; DS:AX = result    
    (mov ax ds)
    (mov iw ax) (iw #x0800)

    (retaf) (iw 8)        ; kill args
    (dl cvr.size cvr.bco)
;*****************************************************************************
;  body code object for code-vector-set!
;*****************************************************************************
    .align-para
    (l cvs!.bco)        ; body code object header
    (iw #x3800)
    (aw cvs!.size)
    (aw cvs!.start)
    (ag cvs!.bco)
    (iw #x0800)
    (iw #x0000)
    
    (dl cvs!.start cvs!.bco)

    (cmp iw ax) (iw 3)           ; check number args = 3
    (jz) (db cvs!.arg.ck)
    (mov ib dl) 1
    (int #x9f)

    (l cvs!.arg.ck)               ; DS:AX = 1st arg 
    (mov sp bx)
    (ss:) (lds (bx db w) ax) 12
    (cmp ib ah) #x6c             ; check for code vector
    (jz) (db cvs!.arg.cv)
    (mov ib dl) 221
    (int #x9f)
   
    (l cvs!.arg.cv)
    (xor ah ah)
    (mov ax si)                  ; DS:SI = untagged to code vector
    (ss:) (mov (bx db w) ax) 8   ; AX = type of 2nd arg
    (cmp ib ah) #x08             ; check for fixnum
    (jz) (db cvs!.arg.fx)
    (mov ib dl) 7
    (int #x9f)
   
    (l cvs!.arg.fx)
    (ss:) (mov (bx db w) cx) 10  ; CX = arg 2
    (mov (si db w) ax) 2         ; AX = code vector size
    (cmp ax cx)
    (jb) (db cvs!.arg.rok)
    (mov ib dl) 11
    (int #x9f)
   
    (l cvs!.arg.rok)
    (add cx si)                  ; DS:SI = untagged to byte in cv
    (add ib si) 4

    (ss:) (mov (bx db w) ax) 4   ; AX = type of 3rd arg
    (cmp ib ah) #x08             ; check for fixnum
    (jz) (db cvs!.arg.fx3)
    (mov ib dl) 7
    (int #x9f)
   
    (l cvs!.arg.fx3)
    (ss:) (mov (bx db w) ax) 6   ; AX = arg 3
    (mov al (si b))
                   
    (xor ax ax)                  ; DS:AX = unspecified
    (mov ax ds)
    (mov iw ax) (iw #x0300)

    (retaf) (iw 12)        ; kill args
    (dl cvs!.size cvs!.bco)
    
;*****************************************************************************
;  body code object for list->code-vector
;*****************************************************************************
;  (()
    .align-para
    (l l->cv.bco)        ; body code object header
    (iw #x3800)
    (aw l->cv.size)
    (aw l->cv.start)
    (ag l->cv.bco)
    (iw #x0800)
    (iw #x0000)
    
    (dl l->cv.start l->cv.bco)
    (push es)                    ; save CP & FP
    (push di)
    (push bp)
    (mov iw bx) (iw #x0f00)
    (push bx)
;  
    (cmp iw ax) (iw 1)                ; check number args = 1
    (jz) (db l->cv.arg.ck)
    (mov ib dl) 1
    (int #x90)
;
;  CX = length of list   (must be < 64000)    
;    
    (l l->cv.arg.ck)               ; DS:AX = 1st arg 
    (mov sp bp)
    (ss:) (lds (bp db w) ax) 12
    (xor cx cx)                   ; list length = cx
;
    (l l->cv.len.loop)
    (cmp ib ah) #x11              ; is 1st arg a pair?
    (jz) (db l->cv.arg.pair)
    (cmp ib ah) #x01
    (jz) (db l->cv.alloc)
    (mov ib dl) 29
    (int #x90)
;
    (l l->cv.arg.pair)
    (mov ax bx)                  ; DS:BX = untagged pair
    (xor bh bh)
    (mov (bx w) ax)              ; AX = type of (car pair)
    (cmp ib ah) #x08             ; must be a fixnum
    (jz) (db l->cv.char.ok)
    (mov ib dl) 7
    (int #x90)
    
    (l l->cv.char.ok)
    (lds (bx db w) ax) 4         ; DS:AX = (cdr pair)
    (inc cx)
    (cmp iw cx) (iw 64000)
    (jb) (db l->cv.len.loop)

    (mov ib dl) 10               ; max length exceeded
    (int #x90)
;
;  alloc cvect size CX and copy list into cvect
;
    (l l->cv.alloc)
    (push cx)            ; save  cvect length
    (mov iw ax) (iw #x0800)
    (push ax)
    (mov cx ax)          ; AX = number paras needed
    (add iw ax) (iw 19)  ; add 4 for header, and 15 to round up
    (mov ib cl) 4        ; divide by 16
    (shr cl ax)
    (inc ax)             ; add 1 para for 000c alignment

    (int #x96)           ; space check and gc call   ES:DI = allocation ptr

    (pop cx)             ; CX = list length -> cvect length
    (pop cx)
    (mov sp bp)
    (ss:) (lds (bp db w) bx) 12  ; DS:BX = arg1 (input list)
;
;  make cvect header
;
    (mov iw di) (iw #x000c)      ; align ES:DI to 4 byte less than paragraph
    (mov di dx)                  ; DX = type & offset of CVO
    (mov ib dh) #x6c
    (cld)
    (mov iw ax) (iw #x7c00)      ; CVO header
    (stos.w)
    (mov cx ax)                  ; CVO length
    (stos.w)
;
;  cvect contents
;
    (and cx cx)
    (jz) (db l->cv.end)
    
    (l l->cv.loop)
    (xor bh bh)  ; DS:BX = untagged pair
    (mov (bx db w) ax) 2  ; put (car pair) in cvect
    (stos.b)
    (lds (bx db w) bx) 4  ; DS:BX = (cdr pair)
    (loop) (db l->cv.loop)

    (l l->cv.end)
    (add ib di) 3     ; adjust DI
    (and iw di) (iw #xfffc)
    
    (mov es ax)       ; DS = cvect segment
    (mov ax ds)
    (mov dx ax)       ; DS:AX = new cvect
    
    (int #x97)        ; update alloc pointer
    
    (pop bp)              ; restore CP & FP
    (pop bp)
    (pop di)
    (pop es)
    (retaf) (iw 4)               ; kill arg
    (dl l->cv.size l->cv.bco)

;****************************************************************************
    )