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
|
|||
|
|
|