// 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) ]