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  * The contents of this file constitute Original Code as defined in and
   7  * are subject to the Apple Public Source License Version 1.1 (the
   8  * "License").  You may not use this file except in compliance with the
   9  * License.  Please obtain a copy of the License at
  10  * http://www.apple.com/publicsource and read it before using this file.
  11  *
  12  * This Original Code and all software distributed under the License are
  13  * distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, EITHER
  14  * EXPRESS OR IMPLIED, AND APPLE HEREBY DISCLAIMS ALL SUCH WARRANTIES,
  15  * INCLUDING WITHOUT LIMITATION, ANY WARRANTIES OF MERCHANTABILITY,
  16  * FITNESS FOR A PARTICULAR PURPOSE OR NON-INFRINGEMENT.  Please see the
  17  * License for the specific language governing rights and limitations
  18  * under the License.
  19  *
  20  * @APPLE_LICENSE_HEADER_END@
  21  */
  22 /*
  23  *  sl_words.c - Forth and C code for the sl_words package.
  24  *
  25  *  Copyright (c) 1998-2000 Apple Computer, Inc.
  26  *
  27  *  DRI: Josh de Cesare
  28  */
  29
  30 #include <sl.h>
  31
  32 #if SL_DEBUG
  33 void InitDebugWords(void);
  34 #endif
  35
  36 extern const char gMacParts[];
  37 extern const char *gControl2Source[];
  38
  39 CICell SLWordsIH = 0;
  40
  41 long InitSLWords(long ofVers)
  42 {
  43   long result, cnt;
  44
  45   result = Interpret_1_1
  46     (
  47      " drop"
  48
  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 spinType"
 101      " 0 value screenIH"
 102      " 0 value cursorAddr"
 103      " 0 value cursorX"
 104      " 0 value cursorY"
 105      " 0 value cursorW"
 106      " 0 value cursorH"
 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      "       spinType 0= if"
 119      "         cursorStage 1+ 3 mod dup to cursorStage"
 120      "         cursorW * cursorH * cursorAddr +"
 121      "         cursorX cursorY cursorW cursorH"
 122      "         \" draw-rectangle\" screenIH $call-method"
 123      "       else"
 124      "         cursorStage 1+ 6 mod dup to cursorStage"
 125      "         dup 3 > if 6 swap - then dup >r"
 126      "         1+ cursorW * cursorPixelSize * cursorAddr +"
 127      "         cursorX cursorY cursorW cursorH r> 1+ -"
 128      "         \" draw-rectangle\" screenIH $call-method"
 129      "       then"
 130      "     else"
 131      "       drop"
 132      "     then"
 133      "   then"
 134      " ;"
 135
 136      // slw_spin_init ( screenIH cursorAddr cursorX cursorY cursorW cursorH --)
 137      " : slw_spin_init"
 138      "   to cursorH to cursorW"
 139      "   to cursorY to cursorX"
 140      "   to cursorAddr to screenIH"
 141      "   d# 111 to cursorDelay"
 142      "   ['] slw_spin to spin"
 143      " ;"
 144
 145      // slw_spin_init2 ( screenIH cursorAddr cursorX cursorY cursorW cursorH--)
 146      " : slw_spin_init2"
 147      "   1 to spinType"
 148      "   to cursorH dup FFFF and to cursorW 10 >> to cursorPixelSize"
 149      "   to cursorY to cursorX"
 150      "   to cursorAddr to screenIH"
 151      "   d# 50 to cursorDelay"
 152      "   ['] slw_spin to spin"
 153      " ;"
 154
 155      // slw_pwd ( phandle addr len -- act )
 156      " : slw_pwd"
 157      "   ['] pwd 138 - execute"
 158      " ;"
 159
 160      // slw_sum ( adr len -- sum )
 161      " : slw_sum { adr len }"
 162      "   len 0 tuck do"
 163      "     dup 1 and if 10000 or then"
 164      "     1 >> adr i + c@ + ffff and"
 165      "   loop"
 166      " ;"
 167
 168      " device-end"
 169
 170      " 0 0 \" sl_words\" $open-package"
 171
 172      , ofVers, &SLWordsIH);
 173
 174   if (result != kCINoError) return result;
 175   if (SLWordsIH == 0) return kCIError;
 176
 177   if (gOFVersion < kOFVersion3x) {
 178     result = Interpret_1_0
 179       (
 180        " dev /packages/obp-tftp"
 181        " ['] load C + l!"
 182        , kLoadSize);
 183     if (result != kCINoError) return result;
 184   }
 185
 186   if (gOFVersion < kOFVersion3x) {
 187     result = Interpret_1_0
 188       (
 189        " dev /packages/mac-parts"
 190        " \" lame\" device-name"
 191        " dev /packages"
 192        " 1 byte-load"
 193        " device-end"
 194        , (long)gMacParts);
 195     if (result != kCINoError) return result;
 196   }
 197
 198   if (gOFVersion < kOFVersion2x) {
 199     for(cnt = 0; gControl2Source[cnt] != '\0'; cnt++) {
 200       result = Interpret_0_0(gControl2Source[cnt]);
 201       if (result == kCIError) return kCIError;
 202       if (result == kCICatch) return kCINoError;
 203     }
 204   }
 205
 206 #if SL_DEBUG
 207   InitDebugWords();
 208 #endif
 209
 210   return kCINoError;
 211 }
 212
 213 #if SL_DEBUG
 214 void InitDebugWords(void)
 215 {
 216   Interpret_0_0
 217     (
 218      // .sc ( -- )
 219      " : .sc ?state-valid ci-regs 4+ l@ l@ dup 0= \" Bad Stack\" (abort\")"
 220      " cr .\" Stack Trace\""
 221     " begin dup while dup 8 + l@ cr u. l@ repeat drop ;"
 222      );
 223 }
 224 #endif
 225
 226 void SetOutputLevel(long level)
 227 {
 228   CallMethod_1_0(SLWordsIH, "slw_set_output_level", level);
 229 }
 230
 231
 232 char *InitKeyMap(CICell keyboardIH)
 233 {
 234   long ret;
 235   char *keyMap;
 236
 237   ret = CallMethod_1_1(SLWordsIH, "slw_init_keymap",
 238                        keyboardIH, (CICell *)&keyMap);
 239   if (ret != kCINoError) return NULL;
 240
 241   return keyMap;
 242 }
 243
 244 void UpdateKeyMap(void)
 245 {
 246   CallMethod_0_0(SLWordsIH, "slw_update_keymap");
 247 }
 248
 249
 250 void SpinInit(long spinType, CICell screenIH, char *cursorAddr,
 251               long cursorX, long cursorY, long cursorW, long cursorH,
 252               long pixelSize)
 253 {
 254   if (spinType == 0) {
 255     CallMethod_6_0(SLWordsIH, "slw_spin_init",
 256                    screenIH, (long)cursorAddr,
 257                    cursorX, cursorY, cursorW, cursorH);
 258   } else {
 259     CallMethod_6_0(SLWordsIH, "slw_spin_init2",
 260                    screenIH, (long)cursorAddr,
 261                    cursorX, cursorY, cursorW | pixelSize << 16, cursorH);
 262   }
 263 }
 264
 265 void Spin(void)
 266 {
 267   CallMethod_0_0(SLWordsIH, "slw_spin");
 268 }
 269
 270 long GetPackageProperty(CICell phandle, char *propName,
 271                         char **propAddr, long *propLen)
 272 {
 273   long ret, nameLen = strlen(propName);
 274
 275   ret = Interpret_3_2("get-package-property if 0 0 then",
 276                       phandle, nameLen, (CICell)propName,
 277                       (CICell *)propLen, (CICell *)propAddr);
 278   if ((ret != kCINoError) || (*propAddr == NULL)) return -1;
 279
 280   return 0;
 281 }