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-2002 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(void)
  42 {
  43   long result, cnt;
  44
  45   result = Interpret(0, 1,
  46      " hex"
  47      " unselect-dev"
  48
  49      // Create the slWords pseudo-device
  50      " \" /packages\" find-device"
  51      " new-device"
  52      " \" sl_words\" device-name"
  53
  54      " : open true ;"
  55      " : close ;"
  56
  57      // Define all sl words here.
  58
  59      // init the outputLevel
  60      " 0 value outputLevel"
  61
  62      // slw_set_output_level ( level -- )
  63      " : slw_set_output_level"
  64      "   dup 0= if 0 stdout ! then"
  65      "   to outputLevel"
  66      " ;"
  67
  68      // slw_emit ( ch -- )
  69      " : slw_emit 2 outputLevel <= if emit else drop then ;"
  70
  71      // slw_cr ( -- )
  72      " : slw_cr   2 outputLevel <= if cr then ;"
  73
  74      // Static init stuff for keyboard
  75      " 0 value keyboardIH"
  76      " 20 buffer: keyMap"
  77
  78      // slw_init_keymap ( keyboardIH -- keyMap )
  79      " : slw_init_keymap"
  80      "   to keyboardIH"
  81      "   keyMap dup 20 0 fill"
  82      " ;"
  83
  84      // slw_update_keymap
  85      " : slw_update_keymap { ; dpth }"
  86      "   depth -> dpth"
  87      "   keyboardIH if"
  88      "     \" get-key-map\" keyboardIH $call-method"
  89      "     depth dpth - 1 = if 20 then"
  90      "     4 / 0 do"
  91      "       dup i 4 * + l@ keyMap i 4 * + tuck l@ or swap l!"
  92      "     loop drop"
  93      "   then"
  94      " ;"
  95
  96      // Set up the spin cursor stuff.
  97      " 0 value screenIH"
  98      " 0 value cursorAddr"
  99      " 0 value cursorX"
 100      " 0 value cursorY"
 101      " 0 value cursorW"
 102      " 0 value cursorH"
 103      " 0 value cursorFrames"
 104      " 0 value cursorPixelSize"
 105      " 0 value cursorStage"
 106      " 0 value cursorTime"
 107      " 0 value cursorDelay"
 108
 109      // slw_spin ( -- )
 110      " : slw_spin"
 111      "   screenIH 0<> cursorAddr 0<> and if"
 112      "     get-msecs dup cursorTime - cursorDelay >= if"
 113      "       to cursorTime"
 114      "       slw_update_keymap"
 115      "       cursorStage 1+ cursorFrames mod dup to cursorStage"
 116      "       cursorW cursorH * cursorPixelSize * * cursorAddr +"
 117      "       cursorX cursorY cursorW cursorH"
 118      "       \" draw-rectangle\" screenIH $call-method"
 119      "     else"
 120      "       drop"
 121      "     then"
 122      "   then"
 123      " ;"
 124
 125      // slw_spin_init ( screenIH cursorAddr cursorX cursorY cursorW cursorH--)
 126      " : slw_spin_init"
 127      "   dup FFFF and to cursorH 10 >> drop"
 128      "   dup FFFF and to cursorW 10 >> to cursorPixelSize"
 129      "   dup FFFF and to cursorY 10 >> d# 1000 swap / to cursorDelay"
 130      "   dup FFFF and to cursorX 10 >> to cursorFrames"
 131      "   to cursorAddr to screenIH"
 132      "   ['] slw_spin to spin"
 133      " ;"
 134
 135      // slw_pwd ( phandle addr len -- act )
 136      " : slw_pwd"
 137      "   ['] pwd 138 - execute"
 138      " ;"
 139
 140      // slw_sum ( adr len -- sum )
 141      " : slw_sum { adr len }"
 142      "   len 0 tuck do"
 143      "     dup 1 and if 10000 or then"
 144      "     1 >> adr i + c@ + ffff and"
 145      "   loop"
 146      " ;"
 147
 148      " device-end"
 149
 150      " 0 0 \" sl_words\" $open-package"
 151
 152      , &SLWordsIH);
 153
 154   if (result != kCINoError) return result;
 155   if (SLWordsIH == 0) return kCIError;
 156
 157   if (gOFVersion < kOFVersion3x) {
 158     result = Interpret(1, 0,
 159        " dev /packages/obp-tftp"
 160        " ['] load C + l!"
 161        , kLoadSize);
 162     if (result != kCINoError) return result;
 163   }
 164
 165   if (gOFVersion < kOFVersion3x) {
 166     result = Interpret(1, 0,
 167        " dev /packages/mac-parts"
 168        " \" lame\" device-name"
 169        " dev /packages"
 170        " 1 byte-load"
 171        " device-end"
 172        , (long)gMacParts);
 173     if (result != kCINoError) return result;
 174   }
 175
 176   if (gOFVersion < kOFVersion2x) {
 177     for(cnt = 0; gControl2Source[cnt] != '\0'; cnt++) {
 178       result = Interpret(0, 0, gControl2Source[cnt]);
 179       if (result == kCIError) return kCIError;
 180       if (result == kCICatch) return kCINoError;
 181     }
 182   }
 183
 184 #if SL_DEBUG
 185   InitDebugWords();
 186 #endif
 187
 188   return kCINoError;
 189 }
 190
 191 #if SL_DEBUG
 192 void InitDebugWords(void)
 193 {
 194   Interpret(0, 0,
 195      // .sc ( -- )
 196      " : .sc ?state-valid ci-regs 4+ l@ l@ dup 0= \" Bad Stack\" (abort\")"
 197      " cr .\" Stack Trace\""
 198      " begin dup while dup 8 + l@ cr u. l@ repeat drop ;"
 199      );
 200 }
 201 #endif
 202
 203 void SetOutputLevel(long level)
 204 {
 205   CallMethod(1, 0, SLWordsIH, "slw_set_output_level", level);
 206 }
 207
 208
 209 char *InitKeyMap(CICell keyboardIH)
 210 {
 211   long ret;
 212   char *keyMap;
 213
 214   ret = CallMethod(1, 1, SLWordsIH, "slw_init_keymap",
 215                    keyboardIH, (CICell *)&keyMap);
 216   if (ret != kCINoError) return NULL;
 217
 218   return keyMap;
 219 }
 220
 221 void UpdateKeyMap(void)
 222 {
 223   CallMethod(0, 0, SLWordsIH, "slw_update_keymap");
 224 }
 225
 226
 227 void SpinInit(CICell screenIH, char *cursorAddr,
 228               long cursorX, long cursorY,
 229               long cursorW, long cursorH,
 230               long frames,  long fps,
 231               long pixelSize, long spare)
 232 {
 233   CallMethod(6, 0, SLWordsIH, "slw_spin_init",
 234              screenIH, (long)cursorAddr,
 235              cursorX | (frames << 16),
 236              cursorY | (fps << 16),
 237              cursorW | (pixelSize << 16),
 238              cursorH | (spare << 16));
 239 }
 240
 241 void Spin(void)
 242 {
 243   CallMethod(0, 0, SLWordsIH, "slw_spin");
 244 }
 245
 246
 247 long GetPackageProperty(CICell phandle, char *propName,
 248                         char **propAddr, long *propLen)
 249 {
 250   long ret, nameLen = strlen(propName);
 251
 252   ret = Interpret(3, 2, "get-package-property if 0 0 then",
 253                   (CICell)propName, nameLen, phandle,
 254                   (CICell *)propAddr, (CICell *)propLen);
 255   if ((ret != kCINoError) || (*propAddr == NULL)) return -1;
 256
 257   return 0;
 258 }