91 lines
3.9 KiB
NASM
91 lines
3.9 KiB
NASM
;***************************************
|
||
;* TIPC Scheme '84 Runtime Support *
|
||
;* Operation Support *
|
||
;* *
|
||
;* (C) Copyright 1984,1985,1986 by *
|
||
;* Texas Instruments Incorporated. *
|
||
;* All rights reserved. *
|
||
;* *
|
||
;* Date Written: 19 April 1984 *
|
||
;* Last Modification: 26 February 1986*
|
||
;***************************************
|
||
include scheme.equ
|
||
|
||
DGROUP group data
|
||
data segment word public 'DATA'
|
||
assume DS:DGROUP
|
||
new_disp dw 0
|
||
new_page dw 0
|
||
data ends
|
||
|
||
PGROUP group prog
|
||
prog segment byte public 'PROG'
|
||
assume CS:PGROUP
|
||
|
||
; CONS Support -- combine two pointers in a new list cell
|
||
con_arg struc
|
||
dw ? ; return address
|
||
con_res dw ? ; address of result register
|
||
con_car dw ? ; address of reg. containing car
|
||
con_cdr dw ? ; address of reg. containing cdr
|
||
con_arg ends
|
||
|
||
extrn alloc_li:near ; C routine to allocate a list cell
|
||
|
||
public cons
|
||
cons proc near
|
||
; Attempt a "short circuit" allocation of a list cell
|
||
mov BX,listpage ; load current list cell allocation page no.
|
||
;;; cmp BX,END_LIST ; is allocation page specified?
|
||
;;; je cons_no
|
||
shl BX,1
|
||
mov SI,nextcell+[BX] ; load next available cell offset
|
||
cmp SI,END_LIST
|
||
je cons_no
|
||
; at this point, the allocation has succeeded
|
||
mov DX,ES ; save the caller's ES register
|
||
LoadPage ES,BX
|
||
;;; mov ES,pagetabl+[BX] ; load list cell page's segment address
|
||
mov AX,ES:[SI].car ; load pointer to next available cell
|
||
mov nextcell+[BX],AX ; and update free cell chain header
|
||
|
||
; store CDR value into list cell
|
||
cons_ok: mov CX,BP ; save the caller's base pointer
|
||
mov BP,SP ; and establish addressability for args
|
||
mov DI,[BP].con_cdr ; fetch address of register containing CDR
|
||
mov AL,byte ptr [DI].C_page ; copy contents of register into
|
||
mov ES:[SI].cdr_page,AL ; the new list cell's CDR field
|
||
mov AX,[DI].C_disp
|
||
mov ES:[SI].cdr,AX
|
||
|
||
; store CAR value into list cell
|
||
mov DI,[BP].con_car ; fetch address of register containing CAR
|
||
mov AL,byte ptr [DI].C_page ; copy contents of register into
|
||
mov ES:[SI].car_page,AL ; the new list cell's CAR field
|
||
mov AX,[DI].C_disp
|
||
mov ES:[SI].car,AX
|
||
|
||
; store pointer to new list cell in destination register
|
||
mov DI,[BP].con_res ; fetch address of destination register
|
||
mov byte ptr [DI].C_page,BL
|
||
mov [DI].C_disp,SI
|
||
|
||
mov ES,DX ; restore caller's ES register
|
||
mov BP,CX ; restore caller's BP register
|
||
ret ; return to caller
|
||
|
||
; OOPS-- no list cell immediately available-- go through channels
|
||
cons_no: mov AX,offset new_disp ; push address of a dummy result
|
||
push AX ; register onto the TIPC's stack
|
||
call alloc_li ; allocate a list cell
|
||
add SP,WORDINCR ; drop argument from stack
|
||
mov BX,new_page ; fetch list cell's page number
|
||
mov SI,new_disp ; and displacement
|
||
mov DX,ES ; save the caller's ES register
|
||
LoadPage ES,BX
|
||
;;; mov ES,pagetabl+[BX] ; make ES point to the new list cell
|
||
jmp cons_ok
|
||
cons endp
|
||
prog ends
|
||
end
|
||
|