pcs/sexec.asm

91 lines
3.9 KiB
NASM
Raw Permalink Normal View History

2023-05-20 05:57:06 -04:00
;***************************************
;* 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