// IfsDvec.bcpl - Routines for dynamic vectors and argument defaulting.
// Copyright Xerox Corporation 1979, 1980

// last modified March 7, 1980  1:21 PM by Taft
// last modified by Butterfield, October 29, 1979  7:34 PM
// - Dvec, adjust savedPC if it points to XARGS - 10/27
// - Dvec, use stackBottom if ifsRuntime is true - 9/7/79

// Based on Dvec.bcpl:
// last modified July 12, 1979  8:15 PM by Taft

get "IfsXEmulator.decl"

external
[
// outgoing procedures
Dvec; 
DefaultArgs

// incoming procedures
CallersFrame; GotoFrame; Usc; SysErr
DoMove

// incoming statics
ifsRuntime
]

manifest
[
endCode = #335

ecDvecStackOverflow = 1002
ecTooFewArguments = 1003
]

structure F:	//BCPL frame
[
callersFrame word
savedPC word
temp word
extraArguments word
formals word
]
manifest formalsOffset = offset F.formals/16


//---------------------------------------------------------------------------
let Dvec(caller, newVecs, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil,
  nil, nil, nil, nil, nil, nil, nil, nil, nil,
 nil; numargs na) = valof
//---------------------------------------------------------------------------
[
let myArgs = lv caller
let cf = CallersFrame()
let top = CallersFrame(cf); if ifsRuntime ne 0 then top = top!stackBottom;
let cfs = top - cf;

let length = 0
let i = 0
while i ls na-1 do
   [
   i = i+1
   if myArgs!i eq 0 break
   length = length + rv myArgs!i+1
   rv myArgs!i = top - length
   ]

while i ls na-1 do
   [
   i = i+1
   let t = rv myArgs!i
   if t ge cf & t ls top then rv myArgs!i = t-length
   ]

let ifsExtra = nil
test ifsRuntime
   ifso
      [
      ifsExtra = cf - cf!stackBottom;
      cf!stackBottom = cf!stackBottom - length;  // adjust stackBottom
      if cf>>F.savedPC eq lv cf!xArgs then  // if extended call,
         cf>>F.savedPC = cf>>F.savedPC - length;  // adjust savedPC
      ]
   ifnot ifsExtra = 0;

let newCf = cf-length
if Usc(newCf - ifsExtra, rv endCode) le 0 then
   SysErr(length, ecDvecStackOverflow)

// MoveBlock(newCf-ifsExtra, cf-ifsExtra, cfs+ifsExtra)
// resultis newCf+cfs
// Moved this to IfsResUtila.asm, because executing it as a table
// caused the XM string machinery to be invoked, thereby screwing up
// all the carefully-computed frame addresses.
//let DoMove = table
//   [
//   #35003	// lda 3 extraArgs,2
//   #157000	// add 2 3
//   #31403	// lda 2 extraArgs,3
//   #35404	// lda 3 extraArgs+1,3
//   #61005	// blt
//   #121400	// inc 1 0	return address of first new word
//   #35001	// lda 3 savedPC,2
//   #1401	// jmp 1,3
//   ]

resultis DoMove(cf-ifsExtra-1, newCf+cfs-1, newCf, -cfs-ifsExtra)  // 0,1,2,3
]


//---------------------------------------------------------------------------
and DefaultArgs(lvNa, base, defaultValue, nil, nil, nil, nil,
  nil, nil, nil, nil, nil; numargs na) be
//---------------------------------------------------------------------------
[
if na ls 2 then base = 0
let defaultOnZero = false
if base ls 0 then [ defaultOnZero = true; base = -base ]

let dvVec = lv defaultValue - base
let actualNumDVs = na-3 + base
let defaultDV = (na ls 3? 0, dvVec!actualNumDVs)
let callersFormals = CallersFrame() + formalsOffset

if @lvNa ls base then SysErr(nil, ecTooFewArguments)

for i = base to (lvNa-callersFormals-1) do
   if i ge @lvNa % (defaultOnZero & callersFormals!i eq 0) then
      callersFormals!i = (i le actualNumDVs ? dvVec!i, defaultDV)
]