bootx.tproj/ci.subproj/sl_words.c

   1 /*
   2  * Copyright (c) 2000 Apple Computer, Inc. All rights reserved.
   3  *
   4  * @APPLE_LICENSE_HEADER_START@
   5  *
   6  * Copyright (c) 1999-2003 Apple Computer, Inc.  All Rights Reserved.
   7  *
   8  * This file contains Original Code and/or Modifications of Original Code
   9  * as defined in and that are subject to the Apple Public Source License
  10  * Version 2.0 (the 'License'). You may not use this file except in
  11  * compliance with the License. Please obtain a copy of the License at
  12  * http://www.opensource.apple.com/apsl/ and read it before using this
  13  * file.
  14  *
  15  * The Original Code and all software distributed under the License are
  16  * distributed on an 'AS IS' basis, WITHOUT WARRANTY OF ANY KIND, EITHER
  17  * EXPRESS OR IMPLIED, AND APPLE HEREBY DISCLAIMS ALL SUCH WARRANTIES,
  18  * INCLUDING WITHOUT LIMITATION, ANY WARRANTIES OF MERCHANTABILITY,
  19  * FITNESS FOR A PARTICULAR PURPOSE, QUIET ENJOYMENT OR NON-INFRINGEMENT.
  20  * Please see the License for the specific language governing rights and
  21  * limitations under the License.
  22  *
  23  * @APPLE_LICENSE_HEADER_END@
  24  */
  25 /*
  26  *  sl_words.c - Forth and C code for the sl_words package.
  27  *
  28  *  Copyright (c) 1998-2002 Apple Computer, Inc.
  29  *
  30  *  DRI: Josh de Cesare
  31  */
  32
  33 #include <sl.h>
  34
  35 #if SL_DEBUG
  36 void InitDebugWords(void);
  37 #endif
  38
  39 extern const char gMacParts[];
  40 extern const char *gControl2Source[];
  41
  42 CICell SLWordsIH = 0;
  43
  44 long InitSLWords(void)
  45 {
  46   long result, cnt;
  47
  48   result = Interpret(0, 1,
  49      " hex"
  50      " unselect-dev"
  51
  52      // Create the slWords pseudo-device
  53      " \" /packages\" find-device"
  54      " new-device"
  55      " \" sl_words\" device-name"
  56
  57      " : open true ;"
  58      " : close ;"
  59
  60      // Define all sl words here.
  61
  62      // init the outputLevel
  63      " 0 value outputLevel"
  64
  65      // slw_set_output_level ( level -- )
  66      " : slw_set_output_level"
  67      "   dup 0= if 0 stdout ! then"
  68      "   to outputLevel"
  69      " ;"
  70
  71      // slw_emit ( ch -- )
  72      " : slw_emit 2 outputLevel <= if emit else drop then ;"
  73
  74      // slw_cr ( -- )
  75      " : slw_cr   2 outputLevel <= if cr then ;"
  76
  77      // Static init stuff for keyboard
  78      " 0 value keyboardIH"
  79      " 20 buffer: keyMap"
  80
  81      // slw_init_keymap ( keyboardIH -- keyMap )
  82      " : slw_init_keymap"
  83      "   to keyboardIH"
  84      "   keyMap dup 20 0 fill"
  85      " ;"
  86
  87      // slw_update_keymap
  88      " : slw_update_keymap { ; dpth }"
  89      "   depth -> dpth"
  90      "   keyboardIH if"
  91      "     \" get-key-map\" keyboardIH $call-method"
  92      "     depth dpth - 1 = if 20 then"
  93      "     4 / 0 do"
  94      "       dup i 4 * + l@ keyMap i 4 * + tuck l@ or swap l!"
  95      "     loop drop"
  96      "   then"
  97      " ;"
  98
  99      // Set up the spin cursor stuff.
 100      " 0 value screenIH"
 101      " 0 value cursorAddr"
 102      " 0 value cursorX"
 103      " 0 value cursorY"
 104      " 0 value cursorW"
 105      " 0 value cursorH"
 106      " 0 value cursorFrames"
 107      " 0 value cursorPixelSize"
 108      " 0 value cursorStage"
 109      " 0 value cursorTime"
 110      " 0 value cursorDelay"
 111
 112      // slw_spin ( -- )
 113      " : slw_spin"
 114      "   screenIH 0<> cursorAddr 0<> and if"
 115      "     get-msecs dup cursorTime - cursorDelay >= if"
 116      "       to cursorTime"
 117      "       slw_update_keymap"
 118      "       cursorStage 1+ cursorFrames mod dup to cursorStage"
 119      "       cursorW cursorH * cursorPixelSize * * cursorAddr +"
 120      "       cursorX cursorY cursorW cursorH"
 121      "       \" draw-rectangle\" screenIH $call-method"
 122      "     else"
 123      "       drop"
 124      "     then"
 125      "   then"
 126      " ;"
 127
 128      // slw_spin_init ( screenIH cursorAddr cursorX cursorY cursorW cursorH--)
 129      " : slw_spin_init"
 130      "   dup FFFF and to cursorH 10 >> drop"
 131      "   dup FFFF and to cursorW 10 >> to cursorPixelSize"
 132      "   dup FFFF and to cursorY 10 >> d# 1000 swap / to cursorDelay"
 133      "   dup FFFF and to cursorX 10 >> to cursorFrames"
 134      "   to cursorAddr to screenIH"
 135      "   ['] slw_spin to spin"
 136      " ;"
 137
 138      // slw_pwd ( phandle addr len -- act )
 139      " : slw_pwd"
 140      "   ['] pwd 138 - execute"
 141      " ;"
 142
 143      // slw_sum ( adr len -- sum )
 144      " : slw_sum { adr len }"
 145      "   len 0 tuck do"
 146      "     dup 1 and if 10000 or then"
 147      "     1 >> adr i + c@ + ffff and"
 148      "   loop"
 149      " ;"
 150
 151      " device-end"
 152
 153      " 0 0 \" sl_words\" $open-package"
 154
 155      , &SLWordsIH);
 156
 157   if (result != kCINoError) return result;
 158   if (SLWordsIH == 0) return kCIError;
 159
 160   if (gOFVersion < kOFVersion3x) {
 161     result = Interpret(1, 0,
 162        " dev /packages/obp-tftp"
 163        " ['] load C + l!"
 164        , kLoadSize);
 165     if (result != kCINoError) return result;
 166   }
 167
 168   if (gOFVersion < kOFVersion3x) {
 169     result = Interpret(1, 0,
 170        " dev /packages/mac-parts"
 171        " \" lame\" device-name"
 172        " dev /packages"
 173        " 1 byte-load"
 174        " device-end"
 175        , (long)gMacParts);
 176     if (result != kCINoError) return result;
 177   }
 178
 179   if (gOFVersion < kOFVersion2x) {
 180     for(cnt = 0; gControl2Source[cnt] != '\0'; cnt++) {
 181       result = Interpret(0, 0, gControl2Source[cnt]);
 182       if (result == kCIError) return kCIError;
 183       if (result == kCICatch) return kCINoError;
 184     }
 185   }
 186
 187 #if SL_DEBUG
 188   InitDebugWords();
 189 #endif
 190
 191   return kCINoError;
 192 }
 193
 194 #if SL_DEBUG
 195 void InitDebugWords(void)
 196 {
 197   Interpret(0, 0,
 198      // .sc ( -- )
 199      " : .sc ?state-valid ci-regs 4+ l@ l@ dup 0= \" Bad Stack\" (abort\")"
 200      " cr .\" Stack Trace\""
 201      " begin dup while dup 8 + l@ cr u. l@ repeat drop ;"
 202      );
 203 }
 204 #endif
 205
 206 void SetOutputLevel(long level)
 207 {
 208   CallMethod(1, 0, SLWordsIH, "slw_set_output_level", level);
 209 }
 210
 211
 212 char *InitKeyMap(CICell keyboardIH)
 213 {
 214   long ret;
 215   char *keyMap;
 216
 217   ret = CallMethod(1, 1, SLWordsIH, "slw_init_keymap",
 218                    keyboardIH, (CICell *)&keyMap);
 219   if (ret != kCINoError) return NULL;
 220
 221   return keyMap;
 222 }
 223
 224 void UpdateKeyMap(void)
 225 {
 226   CallMethod(0, 0, SLWordsIH, "slw_update_keymap");
 227 }
 228
 229
 230 void SpinInit(CICell screenIH, char *cursorAddr,
 231               long cursorX, long cursorY,
 232               long cursorW, long cursorH,
 233               long frames,  long fps,
 234               long pixelSize, long spare)
 235 {
 236   CallMethod(6, 0, SLWordsIH, "slw_spin_init",
 237              screenIH, (long)cursorAddr,
 238              cursorX | (frames << 16),
 239              cursorY | (fps << 16),
 240              cursorW | (pixelSize << 16),
 241              cursorH | (spare << 16));
 242 }
 243
 244 void Spin(void)
 245 {
 246   CallMethod(0, 0, SLWordsIH, "slw_spin");
 247 }
 248
 249
 250 long GetPackageProperty(CICell phandle, char *propName,
 251                         char **propAddr, long *propLen)
 252 {
 253   long ret, nameLen = strlen(propName);
 254
 255   ret = Interpret(3, 2, "get-package-property if 0 0 then",
 256                   (CICell)propName, nameLen, phandle,
 257                   (CICell *)propAddr, (CICell *)propLen);
 258   if ((ret != kCINoError) || (*propAddr == NULL)) return -1;
 259
 260   return 0;
 261 }