home *** CD-ROM | disk | FTP | other *** search
/ MacFormat 1994 November / macformat-018.iso / Utility Spectacular / Developer / macgambit-20-compiler-src-p2 / Runtime (.scm & .s) / _kernel.s < prev    next >
Encoding:
Text File  |  1994-07-26  |  124.3 KB  |  5,526 lines  |  [TEXT/gamI]
  1. /*---------------------------------------------------------------------------*/
  2.  
  3. /* file: "_kernel.s" */
  4.  
  5. /*-----------------------------------------------------------------------------
  6.  
  7. GAMBIT kernel.
  8.  
  9. This file should be assembled with 'AS' to produce '_kernel.O'.
  10. 'kernel.O' is the first object file to be loaded into the system.  The
  11. first object in the file (which must be a procedure) is responsible
  12. for setting up the runtime context and running all the other modules
  13. that were loaded.  This procedure is special because it uses the C
  14. calling convention.
  15.  
  16. -----------------------------------------------------------------------------*/
  17.  
  18.  
  19. /* Main parameters: */
  20.  
  21.  
  22. /* Define MIN_C_CONTEXT if C's context is kept only in A5, A6 and SP */
  23.  
  24. #define MIN_C_CONTEXT
  25.  
  26.  
  27. /* Define DETERMINE_IS_STRICT if 'determine!' should touch its second arg */
  28.  
  29. #define DETERMINE_IS_STRICT
  30.  
  31. #define LIGITIMACY
  32.  
  33.  
  34. /* Define MESSAGE_PASSING_STEAL if tasks are stolen with message passing */
  35. /* protocol (otherwise, shared memory protocol is used) */
  36.  
  37. #define MESSAGE_PASSING_STEAL
  38.  
  39.  
  40. /* Define SYNCHRONOUS_STEAL if thief processor waits for reply from victim */
  41.  
  42. #define SYNCHRONOUS_STEAL
  43.  
  44.  
  45. /* Define MAINTAIN_TASK_STATUS if the status of the tasks should be updated. */
  46. /* There are 4 possible states: READY to run (status=pointer to queue entry),*/
  47. /* RUNNING (status=pointer to processor state), WAITING (status=null) and */
  48. /* DEAD (status=false). */
  49.  
  50. #define MAINTAIN_TASK_STATUS
  51.  
  52.  
  53. /* MAX_FRAME_CHUNK_SIZE is the maximum number of slots in a stack frame */
  54. /* chunk (i.e. a group of contiguous stack frames) */
  55.  
  56. #define MAX_FRAME_CHUNK_SIZE 25
  57. #define MAX_FRAME_CHUNK_SIZEzzz 1024
  58.  
  59.  
  60. /* MAX_TASK_FRAME_CHUNK_SIZE is the maximum number of slots in a stack frame */
  61. /* chunk which contains lazy tasks.  MIN_VICTIM_TASKS is the minimum number */
  62. /* of lazy tasks to leave the victim when there is a steal of more than one */
  63. /* task. */
  64.  
  65. #define MAX_TASK_FRAME_CHUNK_SIZEzzz 25
  66. #define MIN_VICTIM_TASKSzzz 20
  67. #define MAX_TASK_FRAME_CHUNK_SIZE 25
  68. #define MIN_VICTIM_TASKS 20
  69.  
  70.  
  71. /* Interrupt checking latencies (1 = soonest possible) */
  72.  
  73. #define INTR_LATENCY_AFTER_STEAL 5
  74.  
  75.  
  76. /*---------------------------------------------------------------------------*/
  77.  
  78.  
  79. /* DYN_ENV_FS is the size of a dynamic environment frame */
  80.  
  81. #define DYN_ENV_FS 2
  82.  
  83.  
  84. /*---------------------------------------------------------------------------*/
  85.  
  86.  
  87. /* String concatenation depends on style of preprocessing... */
  88. #ifdef __STDC__
  89. #define MAKE_LBL(x,y)y##__##x
  90. #else
  91. #define QUOTE(x)x
  92. #define MAKE_LBL(x,y)QUOTE(QUOTE(y)__)x
  93. #endif
  94.  
  95.  
  96. #ifdef hpux
  97.  
  98. /* HPUX assembler definitions... */
  99.  
  100. #define OBJECT_FILE_BEGIN _object_file_begin: global _object_file_begin
  101. #define OBJECT_FILE_END _object_file_end: global _object_file_end
  102.  
  103. #define DISP(r,n)    n(r)
  104. #define INXW(r,i,n)  n(r,i.w)
  105. #define PC_IND(lab)  LBL(lab)(%pc)
  106. #define ALIGN2       lalign 2
  107. #define ALIGN4       lalign 4
  108. #define ALIGN8       lalign 8
  109. #define SET(a,b)     set a,b
  110. #define CONST(n)     LBL($consts)+(n*4)(%pc)
  111. #define REG(x)       %x
  112. #define IMM(x)       &x
  113. #define PINC(r)      (r)+
  114. #define PDEC(r)      -(r)
  115. #define IND(r)       (r)
  116. #define BYTE         byte
  117. #define WORD         short
  118. #define LONG         long
  119. #define ASCIZ        asciz
  120. #define movb         move.b
  121. #define movw         move.w
  122. #define movl         move.l
  123. #define extl         ext.l
  124. #define addw         add.w
  125. #define addl         add.l
  126. #define addqw        addq.w
  127. #define addql        addq.l
  128. #define subw         sub.w
  129. #define subl         sub.l
  130. #define subqw        subq.w
  131. #define subql        subq.l
  132. #define negl         neg.l
  133. #define clrb         clr.b
  134. #define clrl         clr.l
  135. #define muluw        mulu.w
  136. #define notw         not.w
  137. #define andw         and.w
  138. #define andl         and.l
  139. #define aslw         asl.w
  140. #define asll         asl.l
  141. #define asrw         asr.w
  142. #define asrl         asr.l
  143. #define lsrw         lsr.w
  144. #define lsrl         lsr.l
  145. #define tstw         tst.w
  146. #define tstl         tst.l
  147. #define CMPW(x,y)    cmp.w y,x
  148. #define CMPL(x,y)    cmp.l y,x
  149. #define DBRA(r,lab)  dbra r,LBL(lab)
  150. #define BRAS(lab)    bra.b LBL(lab)
  151. #define BEQS(lab)    beq.b LBL(lab)
  152. #define BEQW(lab)    beq.w LBL(lab)
  153. #define BNES(lab)    bne.b LBL(lab)
  154. #define BNEW(lab)    bne.w LBL(lab)
  155. #define BMIS(lab)    bmi.b LBL(lab)
  156. #define BMIW(lab)    bmi.w LBL(lab)
  157. #define BPLS(lab)    bpl.b LBL(lab)
  158. #define BPLW(lab)    bpl.w LBL(lab)
  159. #define BLES(lab)    ble.b LBL(lab)
  160. #define BLEW(lab)    ble.w LBL(lab)
  161. #define BGES(lab)    bge.b LBL(lab)
  162. #define BCCS(lab)    bcc.b LBL(lab)
  163. #define BCCW(lab)    bcc.w LBL(lab)
  164. #define BCSS(lab)    bcs.b LBL(lab)
  165. #define BCSW(lab)    bcs.w LBL(lab)
  166. #define BLSS(lab)    bls.b LBL(lab)
  167. #define BHIS(lab)    bhi.b LBL(lab)
  168. #define BGTS(lab)    bgt.b LBL(lab)
  169. #define BGTW(lab)    bgt.w LBL(lab)
  170. #define BLTS(lab)    blt.b LBL(lab)
  171. #define BRAW(lab)    bra.w LBL(lab)
  172. #define BSRW(lab)    bsr.w LBL(lab)
  173.  
  174. #define fmovel       fmov.l
  175. #define FPCR         %fpcr
  176. #define FPSR         %fpsr
  177.  
  178. #else
  179.  
  180. /* SUN3 assembler definitions... */
  181.  
  182. #define OBJECT_FILE_BEGIN _object_file_begin: .globl _object_file_begin
  183. #define OBJECT_FILE_END _object_file_end: .globl _object_file_end
  184.  
  185. #define DISP(r,n)    r@(n:w)
  186. #define INXW(r,i,n)  r@(n:w,i:w)
  187. #define PC_IND(lab)  pc@(-2-(.-LBL(lab)):w)
  188. #define ALIGN2       .even
  189. #define ALIGN4       .=(.-_object_file_begin+3)/4*4
  190. #define ALIGN8       .=(.-_object_file_begin+7)/8*8
  191. #define SET(a,b)     a = b
  192. #define CONST(n)     pc@((n*4)-2-(.-LBL($consts)):w)
  193. #define REG(r)       r
  194. #define IMM(x)       #x
  195. #define PINC(r)      r@+
  196. #define PDEC(r)      r@-
  197. #define IND(r)       r@
  198. #define BYTE         .byte
  199. #define WORD         .word
  200. #define LONG         .long
  201. #define ASCIZ        .asciz
  202. #define muluw        mulu
  203. #define CMPW(x,y)    cmpw x,y
  204. #define CMPL(x,y)    cmpl x,y
  205. #define DBRA(r,lab)  dbra r,LBL(lab)
  206. #define BRAS(lab)    BYTE 0x60,LBL(lab)-.-2
  207. #define BEQS(lab)    BYTE 0x67,LBL(lab)-.-2
  208. #define BEQW(lab)    WORD 0x6700,LBL(lab)-.-2
  209. #define BNES(lab)    BYTE 0x66,LBL(lab)-.-2
  210. #define BNEW(lab)    WORD 0x6600,LBL(lab)-.-2
  211. #define BMIS(lab)    BYTE 0x6b,LBL(lab)-.-2
  212. #define BMIW(lab)    WORD 0x6b00,LBL(lab)-.-2
  213. #define BPLS(lab)    BYTE 0x6a,LBL(lab)-.-2
  214. #define BPLW(lab)    WORD 0x6a00,LBL(lab)-.-2
  215. #define BLES(lab)    BYTE 0x6f,LBL(lab)-.-2
  216. #define BLEW(lab)    WORD 0x6f00,LBL(lab)-.-2
  217. #define BGES(lab)    BYTE 0x6c,LBL(lab)-.-2
  218. #define BCCS(lab)    BYTE 0x64,LBL(lab)-.-2
  219. #define BCCW(lab)    WORD 0x6400,LBL(lab)-.-2
  220. #define BCSS(lab)    BYTE 0x65,LBL(lab)-.-2
  221. #define BCSW(lab)    WORD 0x6500,LBL(lab)-.-2
  222. #define BLSS(lab)    BYTE 0x63,LBL(lab)-.-2
  223. #define BHIS(lab)    BYTE 0x62,LBL(lab)-.-2
  224. #define BGTS(lab)    BYTE 0x6e,LBL(lab)-.-2
  225. #define BGTW(lab)    WORD 0x6e00,LBL(lab)-.-2
  226. #define BLTS(lab)    BYTE 0x6d,LBL(lab)-.-2
  227. #define BRAW(lab)    WORD 0x6000,LBL(lab)-.-2
  228. #define BSRW(lab)    WORD 0x6100,LBL(lab)-.-2
  229.  
  230. #define FPCR         fpcr
  231. #define FPSR         fpsr
  232.  
  233.     .data
  234.  
  235. #endif
  236.  
  237.  
  238. /* General definitions... */
  239.  
  240.  
  241. #define PRIMITIVE(name)                            \
  242. %NEWLINE%    LONG PRIM_PROC+(INDEX_MASK*8)                \
  243. %NEWLINE%    ASCIZ name                        \
  244. %NEWLINE%    ALIGN2
  245.  
  246. #define BEGIN(name)                            \
  247. %NEWLINE%    LONG PRIM_PROC_PREFIX                    \
  248. %NEWLINE%    WORD INDEX_MASK                        \
  249. %NEWLINE%    ASCIZ name                        \
  250. %NEWLINE%    ALIGN2                            \
  251. %NEWLINE%    WORD LBL($header)                    \
  252. %NEWLINE%    ALIGN8                            \
  253. %NEWLINE%    WORD LBL($code_len_tag)                    \
  254. %NEWLINE%LBL($entry):
  255.  
  256. #define CONSTS(n)                            \
  257. %NEWLINE%    ALIGN4                            \
  258. %NEWLINE%LBL($consts):                            \
  259. %NEWLINE%    WORD END_OF_CODE_TAG                    \
  260. %NEWLINE%    SET(LBL($nb_consts),n+2)
  261.     
  262. #define END                                \
  263. %NEWLINE%    LONG SCM_false                        \
  264. %NEWLINE%    LONG LBL($nb_consts)*8                    \
  265. %NEWLINE%    SET(LBL($code_len),LBL($consts)-LBL($entry))        \
  266. %NEWLINE%    SET(LBL($code_len_tag),LBL($code_len)/2)        \
  267. %NEWLINE%    SET(LBL($header),HEADER(LBL($nb_consts)*4)+LBL($code_len)-2)
  268.  
  269. #define HEADER(l)    ((l)+0x8000)
  270. #define GLOB_OFFS(x) (((x)*8)-(MAX_NB_GLOBALS*10)-(NB_TRAPS*8)+0x8000)
  271. #define TRAP_OFFS(x) (((x)-NB_TRAPS)*8+0x8000)
  272. #define STAT_OFFS(x) (((x)-MAX_NB_STATS)*4)
  273. #define SLOT(x)      ((x)*4)
  274.  
  275. #define RETURN(lab,fs,link)                        \
  276. %NEWLINE%    ALIGN8                            \
  277. %NEWLINE%    LONG    0                        \
  278. %NEWLINE%    WORD    (fs)*4                        \
  279. %NEWLINE%    WORD    ((fs)-(link))*4                    \
  280. %NEWLINE%    WORD    -0x8002-(.-LBL($entry))                \
  281. %NEWLINE%LBL(lab)
  282.  
  283. #define RETURN_LAZY(lab,fs,link)                    \
  284. %NEWLINE%    ALIGN8                            \
  285. %NEWLINE%    LONG    0                        \
  286. %NEWLINE%    WORD    -0x8000+(fs)*4                    \
  287. %NEWLINE%    WORD    ((fs)-(link))*4                    \
  288. %NEWLINE%    WORD    -0x8002-(.-LBL($entry))                \
  289. %NEWLINE%LBL(lab)
  290.  
  291. #define SUBPROC(lab)                            \
  292. %NEWLINE%    ALIGN8                            \
  293. %NEWLINE%    WORD    -0x8002-(.-LBL($entry))                \
  294. %NEWLINE%LBL(lab)
  295.  
  296. #define WRONG_NB_ARGS(x,n,lab)                        \
  297. %NEWLINE%    jsr DISP(TABLE_REG,TRAP_OFFS(x))            \
  298. %NEWLINE%    WORD n                            \
  299. %NEWLINE%    WORD .-LBL(lab)
  300.  
  301. #define TRAP(x,lab,fs,link)                        \
  302. %NEWLINE%    BRAS(    lab)                        \
  303. %NEWLINE%    nop                            \
  304. %NEWLINE%    ALIGN8                            \
  305. %NEWLINE%LBL(lab):                            \
  306. %NEWLINE%    jsr DISP(TABLE_REG,TRAP_OFFS(x))            \
  307. %NEWLINE%    WORD    fs*4                        \
  308. %NEWLINE%    WORD    (fs-link)*4                    \
  309. %NEWLINE%    WORD    -0x8002-(.-LBL($entry))
  310.  
  311. #define GET_TRAP_RETURN(nb_args)                    \
  312. %NEWLINE%    GET_TRAP_RET(nb_args)                    \
  313. %NEWLINE%    addql    IMM(SCM_type_PROCEDURE),DTEMP1
  314.  
  315. #define GET_TRAP_RET(nb_args)                        \
  316. %NEWLINE%    moveq    IMM(11+(nb_args*2)),DTEMP1            \
  317. %NEWLINE%    addl    PINC(SP),DTEMP1                    \
  318. %NEWLINE%    andw    IMM(-8),DTEMP1
  319.  
  320. #define MOVE_ARGS_TO_STACK(arg_count)                    \
  321. %NEWLINE%    movw    arg_count,DTEMP1                \
  322. %NEWLINE%    BPLS(    not_1_arg)                    \
  323. %NEWLINE%    moveq    IMM(1),DTEMP1        /* 1 arg passed */    \
  324. %NEWLINE%    movl    PVM1_REG,PDEC(SP)                \
  325. %NEWLINE%    BRAS(    args_pushed)                    \
  326. %NEWLINE%LBL(not_1_arg):                        \
  327. %NEWLINE%    BNES(    not_1_or_2_args)                \
  328. %NEWLINE%    moveq    IMM(2),DTEMP1        /* 2 args passed */    \
  329. %NEWLINE%    movl    PVM1_REG,PDEC(SP)                \
  330. %NEWLINE%    movl    PVM2_REG,PDEC(SP)                \
  331. %NEWLINE%    BRAS(    args_pushed)                    \
  332. %NEWLINE%LBL(not_1_or_2_args):                        \
  333. %NEWLINE%    subqw    IMM(1),DTEMP1                    \
  334. %NEWLINE%    BEQS(    args_pushed)                    \
  335. %NEWLINE%    movl    PVM1_REG,PDEC(SP)    /* 3 or more args passed */\
  336. %NEWLINE%    movl    PVM2_REG,PDEC(SP)                \
  337. %NEWLINE%    movl    PVM3_REG,PDEC(SP)                \
  338. %NEWLINE%LBL(args_pushed):
  339.  
  340. #define RESET_STACK                            \
  341. %NEWLINE%    movl    DISP(PSTATE_REG,SLOT(STACK_TOP)),SP        \
  342. %NEWLINE%    movl    DISP(PSTATE_REG,SLOT(Q_BOT)),LTQ_TAIL_REG    \
  343. %NEWLINE%    movl    SP,PINC(LTQ_TAIL_REG)                \
  344. %NEWLINE%    movl    LTQ_TAIL_REG,DISP(PSTATE_REG,SLOT(LTQ_HEAD))     \
  345. %NEWLINE%    movl    DISP(PSTATE_REG,SLOT(Q_TOP)),ATEMP1        \
  346. %NEWLINE%    movl    SP,PDEC(ATEMP1)                    \
  347. %NEWLINE%    movl    ATEMP1,DISP(PSTATE_REG,SLOT(DEQ_TAIL))        \
  348. %NEWLINE%    movl    ATEMP1,DISP(PSTATE_REG,SLOT(DEQ_HEAD))
  349.  
  350. #define MAKE_TEMP_TASK                            \
  351. %NEWLINE%    clrl    PDEC(HEAP_REG) /* Make legitimacy PH */        \
  352. %NEWLINE%    clrl    PDEC(HEAP_REG)                    \
  353. %NEWLINE%    movl    NULL_REG,PDEC(HEAP_REG)                \
  354. %NEWLINE%    lea    DISP(HEAP_REG,SCM_type_PLACEHOLDER-4),ATEMP2    \
  355. %NEWLINE%    movl    ATEMP2,PDEC(HEAP_REG)                \
  356. %NEWLINE%    clrl    PDEC(HEAP_REG) /* Make value PH */        \
  357. %NEWLINE%    clrl    PDEC(HEAP_REG)                    \
  358. %NEWLINE%    movl    NULL_REG,PDEC(HEAP_REG)                \
  359. %NEWLINE%    lea    DISP(HEAP_REG,SCM_type_PLACEHOLDER-4),ATEMP1    \
  360. %NEWLINE%    movl    ATEMP1,PDEC(HEAP_REG)                \
  361. %NEWLINE%    clrl    PDEC(HEAP_REG) /* Make task */            \
  362. %NEWLINE%    clrl    PDEC(HEAP_REG)                    \
  363. %NEWLINE%    movl    FALSE_REG,PDEC(HEAP_REG)            \
  364. %NEWLINE%    movl    ATEMP1,PDEC(HEAP_REG)                \
  365. %NEWLINE%    movl    ATEMP1,PDEC(HEAP_REG)                \
  366. %NEWLINE%    movl    ATEMP2,PDEC(HEAP_REG)                \
  367. %NEWLINE%    clrl    PDEC(HEAP_REG)                    \
  368. %NEWLINE%    clrl    PDEC(HEAP_REG)                    \
  369. %NEWLINE%    clrl    PDEC(HEAP_REG)                    \
  370. %NEWLINE%    movl    IMM(TASK_SIZE*0x400+(SCM_subtype_TASK*8)),PDEC(HEAP_REG) \
  371. %NEWLINE%    lea    DISP(HEAP_REG,SCM_type_SUBTYPED),ATEMP1        \
  372. %NEWLINE%    movl    ATEMP1,DISP(PSTATE_REG,SLOT(TEMP_TASK))
  373.  
  374. #ifdef STATS
  375.  
  376. #define STAT(n,x)                            \
  377. %NEWLINE%    addql IMM(n),DISP(PSTATE_REG,STAT_OFFS(x))
  378.  
  379. #define STAT_DTEMP1(x)                            \
  380. %NEWLINE%    addl  DTEMP1,DISP(PSTATE_REG,STAT_OFFS(x))
  381.  
  382. #else
  383.  
  384. #define STAT(n,x)
  385. #define STAT_DTEMP1(x)
  386.  
  387. #endif
  388.  
  389. #ifdef butterfly
  390.  
  391. #define ATOMCTA16 0 = a0, mask/incr = d1, adr = d0
  392. #define ATOMADD32 1
  393. #define ATOMAND32 2
  394. #define ATOMIOR32 3
  395.  
  396. #define DO_ATOMIC                            \
  397. %NEWLINE%    trap IMM(0xe)
  398.  
  399. #define DO_BTRANSFER                            \
  400. %NEWLINE%    trap IMM(0xc)
  401.  
  402. #define DO_GETRTC                            \
  403. %NEWLINE%    trap IMM(0xd)
  404.  
  405. #define ADD_TO_DTEMP1()                            \
  406. %NEWLINE%                    /* d0 = address, d1 = value */\
  407. %NEWLINE%    movw    IMM(ATOMADD32),PVM0_REG    /* a0 = atomadd32 command   */\
  408. %NEWLINE%    DO_ATOMIC            /* d0,a0,a1 not preserved   */
  409.  
  410. #define READ_AND_CLEAR_DTEMP1                        \
  411. %NEWLINE%                    /* d0 = address             */\
  412. %NEWLINE%    movw    IMM(ATOMAND32),PVM0_REG    /* a0 = atomand32 command   */\
  413. %NEWLINE%    moveq    IMM(0),PVM1_REG        /* d1 = mask                */\
  414. %NEWLINE%    DO_ATOMIC            /* d0,a0,a1 not preserved   */
  415.  
  416. #define READ_AND_SET_DTEMP1                        \
  417. %NEWLINE%                    /* d0 = address             */\
  418. %NEWLINE%    movw    IMM(ATOMIOR32),PVM0_REG    /* a0 = atomior32 command   */\
  419. %NEWLINE%    moveq    IMM(-1),PVM1_REG    /* d1 = mask                */\
  420. %NEWLINE%    DO_ATOMIC            /* d0,a0,a1 not preserved   */
  421.  
  422. #define LOCK_ATEMP1(lab)                        \
  423. %NEWLINE%     movl    ATEMP1,PVM4_REG                    \
  424. %NEWLINE%LBL(lab):                            \
  425. %NEWLINE%    movw    IMM(ATOMIOR32),PVM0_REG    /* a0 = atomior32 command   */\
  426. %NEWLINE%    movl    PVM4_REG,DTEMP1        /* d0 = address             */\
  427. %NEWLINE%    moveq    IMM(-1),PVM1_REG    /* d1 = mask                */\
  428. %NEWLINE%    DO_ATOMIC            /* d0,a0,a1 not preserved   */\
  429. %NEWLINE%    CMPL(    DTEMP1,PVM1_REG)                \
  430. %NEWLINE%    BEQS(    lab)                        \
  431. %NEWLINE%    movl    PVM4_REG,ATEMP1                    \
  432.  
  433. #define LOCK_ATEMP2(lab)                        \
  434. %NEWLINE%LBL(lab):                            \
  435. %NEWLINE%    movw    IMM(ATOMIOR32),PVM0_REG    /* a0 = atomior32 command   */\
  436. %NEWLINE%    movl    ATEMP2,DTEMP1        /* d0 = address             */\
  437. %NEWLINE%    moveq    IMM(-1),PVM1_REG    /* d1 = mask                */\
  438. %NEWLINE%    DO_ATOMIC            /* d0,a0,a1 not preserved   */\
  439. %NEWLINE%    CMPL(    DTEMP1,PVM1_REG)                \
  440. %NEWLINE%    BEQS(    lab)
  441.  
  442. #define BTRANSFER(lab)                            \
  443. %NEWLINE%    DO_BTRANSFER    /* a0 = src, d0 = dest, d1 = nb of bytes    */\
  444. %NEWLINE%            /* d0,d1,a1 not preserved                   */
  445.  
  446. #ifdef ELOG
  447.  
  448. #define LOG(event_num,lab)                        \
  449. %NEWLINE%    DO_GETRTC    /* d0 = real time clock value */    \
  450. %NEWLINE%    movl    DISP(PSTATE_REG,SLOT(ELOG_PTR)),ATEMP1        \
  451. %NEWLINE%    CMPL(    DISP(PSTATE_REG,SLOT(ELOG_BOT)),ATEMP1)        \
  452. %NEWLINE%    BEQS(    lab)                        \
  453. %NEWLINE%    movl    DTEMP1,PDEC(ATEMP1)                \
  454. %NEWLINE%    movb    IMM(event_num),IND(ATEMP1)            \
  455. %NEWLINE%    movl    ATEMP1,DISP(PSTATE_REG,SLOT(ELOG_PTR))        \
  456. %NEWLINE%LBL(lab):
  457.  
  458. #define PREV_LOG(n,lab)                            \
  459. %NEWLINE%    DO_GETRTC    /* d0 = real time clock value */    \
  460. %NEWLINE%    movl    DISP(PSTATE_REG,SLOT(ELOG_PTR)),ATEMP1        \
  461. %NEWLINE%    CMPL(    DISP(PSTATE_REG,SLOT(ELOG_BOT)),ATEMP1)        \
  462. %NEWLINE%    BEQS(    lab)                        \
  463. %NEWLINE%    movl    DTEMP1,PDEC(ATEMP1)                \
  464. %NEWLINE%    movb    DISP(ATEMP1,4*n),IND(ATEMP1)            \
  465. %NEWLINE%    movl    ATEMP1,DISP(PSTATE_REG,SLOT(ELOG_PTR))        \
  466. %NEWLINE%LBL(lab):
  467.  
  468. #else
  469.  
  470. #define LOG(x,lab)
  471. #define PREV_LOG(x,lab)
  472.  
  473. #endif
  474.  
  475. #else
  476.  
  477. #define ADD_TO_DTEMP1
  478.  
  479. #define READ_AND_CLEAR_DTEMP1                        \
  480. %NEWLINE%    movl    DTEMP1,ATEMP1                    \
  481. %NEWLINE%    movl    IND(ATEMP1),DTEMP1                \
  482. %NEWLINE%    clrl    IND(ATEMP1)
  483.  
  484. #define READ_AND_SET_DTEMP1                        \
  485. %NEWLINE%    movl    DTEMP1,ATEMP1                    \
  486. %NEWLINE%    movl    IND(ATEMP1),DTEMP1                \
  487. %NEWLINE%    movl    IMM(-1),IND(ATEMP1)
  488.  
  489. #define LOCK_ATEMP1(lab)                        \
  490. %NEWLINE%    movl    IND(ATEMP1),DTEMP1
  491.  
  492. #define LOCK_ATEMP2(lab)                        \
  493. %NEWLINE%    movl    IND(ATEMP2),DTEMP1
  494.  
  495. #define BTRANSFER(lab)                            \
  496. %NEWLINE%    movl    DTEMP1,ATEMP1                    \
  497. %NEWLINE%    lsrl    IMM(2),PVM1_REG                    \
  498. %NEWLINE%    subql    IMM(1),PVM1_REG                    \
  499. %NEWLINE%LBL(lab):                            \
  500. %NEWLINE%    movl    PINC(PVM0_REG),PINC(ATEMP1)            \
  501. %NEWLINE%    DBRA(    PVM1_REG,lab)
  502.  
  503. #define LOG(x,lab)
  504. #define PREV_LOG(x,lab)
  505.  
  506. #endif
  507.  
  508.  
  509. #define WORK_REQUEST THIEF
  510.  
  511.  
  512. /* Registers... */
  513.  
  514.  
  515. #define PVM0_REG        REG(a0)
  516. #define PVM1_REG        REG(d1)
  517. #define PVM2_REG        REG(d2)
  518. #define PVM3_REG        REG(d3)
  519. #define PVM4_REG        REG(d4)
  520. #define CLOSURE_REG     REG(d4)
  521. #define INTR_TIMER_REG  REG(d5)
  522. #define NULL_REG        REG(d6)
  523. #define PLACEHOLDER_REG REG(d6)
  524. #define FALSE_REG       REG(d7)
  525. #define PAIR_REG        REG(d7)
  526.  
  527. #define DTEMP1          REG(d0)
  528. #define ATEMP1          REG(a1)
  529. #define ATEMP2          REG(a2)
  530.  
  531. #define HEAP_REG        REG(a3)
  532. #define LTQ_TAIL_REG    REG(a4)
  533. #define PSTATE_REG      REG(a5)
  534. #define TABLE_REG       REG(a6)
  535. #define SP              REG(a7)
  536.  
  537.  
  538. /*---------------------------------------------------------------------------*/
  539.  
  540. /* Start of kernel... */
  541.  
  542. OBJECT_FILE_BEGIN
  543.     WORD    OFILE_VERSION_MAJOR    /* Stamp with appropriate version */
  544.     WORD    OFILE_VERSION_MINOR
  545.  
  546. /*---------------------------------------------------------------------------*/
  547.  
  548. /*
  549.  
  550. *** The first procedure (i.e. '###_kernel') is called from C as in:
  551. ***
  552. *** kernel_startup( table, pstate, os_M68881 );
  553.  
  554. */
  555.  
  556. #undef LBL
  557. #define LBL(x)MAKE_LBL(00,x)
  558.  
  559. BEGIN("###_kernel")
  560.  
  561.     movl    CONST(0),PVM0_REG    /* jump to #_kernel.startup */
  562.     jmp    IND(PVM0_REG)
  563.  
  564. /* Reserve space for saving C's context */
  565.  
  566.     LONG    0    /* C's D2 register */
  567.     LONG    0    /* C's D3 register */
  568.     LONG    0    /* C's D4 register */
  569.     LONG    0    /* C's D5 register */
  570.     LONG    0    /* C's D6 register */
  571.     LONG    0    /* C's D7 register */
  572.     LONG    0    /* C's A2 register */
  573.     LONG    0    /* C's A3 register */
  574.     LONG    0    /* C's A4 register */
  575.     LONG    0    /* C's A5 register */
  576.     LONG    0    /* C's A6 register */
  577.     LONG    0    /* C's SP register */
  578.  
  579.     SET(C_D2,6)
  580.     SET(C_D3,10)
  581.     SET(C_D4,14)
  582.     SET(C_D5,18)
  583.     SET(C_D6,22)
  584.     SET(C_D7,26)
  585.     SET(C_A2,30)
  586.     SET(C_A3,34)
  587.     SET(C_A4,38)
  588.     SET(C_A5,42)
  589.     SET(C_A6,46)
  590.     SET(C_SP,50)
  591.  
  592. CONSTS(1)
  593. PRIMITIVE("###_kernel.startup")
  594. END
  595.  
  596. /*---------------------------------------------------------------------------*/
  597.  
  598. #undef LBL
  599. #define LBL(x)MAKE_LBL(01,x)
  600.  
  601. BEGIN("###_kernel.trap_0")
  602.  
  603. /* global_jump */
  604.  
  605.     movl    IMM(SCM_false),FALSE_REG /* d7 was clobbered so restore it */
  606.  
  607.     movw    DTEMP1,PDEC(SP)        /* save argument count temporarily */
  608.     movl    ATEMP1,DTEMP1
  609.  
  610.     addl    IMM((MAX_NB_GLOBALS*2)+(NB_TRAPS*8-0x8000)),DTEMP1
  611.     subl    TABLE_REG,DTEMP1
  612.     asll    IMM(2),DTEMP1
  613.     addl    TABLE_REG,DTEMP1
  614.     subl    IMM((MAX_NB_GLOBALS*10)+(NB_TRAPS*8-0x8000)),DTEMP1
  615.  
  616.     movl    DTEMP1,ATEMP1
  617.     movl    PINC(ATEMP1),DTEMP1
  618.  
  619.     movl    DTEMP1,ATEMP2
  620.     addql    IMM(SCM_type_PAIR-SCM_type_PROCEDURE),DTEMP1
  621.     btst    DTEMP1,PAIR_REG
  622.     BNES(    not_a_proc)
  623.  
  624.     movl    ATEMP2,IND(ATEMP1)    /* replace trap adr by procedure adr */
  625.     movw    PINC(SP),DTEMP1        /* restore argument count and set flags */
  626.     jmp    IND(ATEMP2)        /* jump to procedure */
  627.  
  628. LBL(not_a_proc):
  629.     subql    IMM(4),ATEMP1        /* compute 'global variable index' */
  630.     addl    IMM((MAX_NB_GLOBALS*10)+(NB_TRAPS*8-0x8000)),ATEMP1
  631.     subl    TABLE_REG,ATEMP1
  632.  
  633.     MOVE_ARGS_TO_STACK(PINC(SP))
  634.  
  635. /* make room for 'global variable index' argument */
  636.  
  637.     movw    DTEMP1,PVM1_REG
  638.     movl    SP,ATEMP2
  639.     subql    IMM(4),SP
  640.     BRAS(    loop_entry)
  641. LBL(loop):
  642.     movl    PINC(ATEMP2),DISP(ATEMP2,-8)
  643. LBL(loop_entry):
  644.     DBRA(    PVM1_REG,loop)
  645.  
  646.     movl    ATEMP1,DISP(ATEMP2,-4)
  647.     addqw    IMM(1),DTEMP1
  648.  
  649.     movl    CONST(0),ATEMP1    /* apply ##exception.global-jump */
  650.     movl    CONST(1),ATEMP2
  651.     jmp    IND(ATEMP2)
  652.  
  653. CONSTS(2)
  654. PRIMITIVE("##exception.global-jump")
  655. PRIMITIVE("###_kernel.apply")
  656. END
  657.  
  658. /*---------------------------------------------------------------------------*/
  659.  
  660. #undef LBL
  661. #define LBL(x)MAKE_LBL(02,x)
  662.  
  663. BEGIN("###_kernel.trap_1")
  664.  
  665. /* touch d0 */
  666.  
  667.     movl    DTEMP1,ATEMP2
  668.  
  669.     GET_TRAP_RETURN(0)
  670.     movl    DTEMP1,PVM0_REG
  671.  
  672. LBL(touch):
  673.     movl    DISP(ATEMP2,SLOT(PH_VALUE)-SCM_type_PLACEHOLDER),DTEMP1
  674.     CMPL(    ATEMP2,DTEMP1)
  675.     BNES(    determined)
  676.  
  677.     LOG(EVENT_TOUCH_UNDET,log1)
  678.  
  679. #ifdef DETERMINE_IS_STRICT
  680.  
  681.     movl    CONST(0),ATEMP1
  682.     jmp    IND(ATEMP1)    /* jump to ###_kernel.touch */
  683. LBL(determined):
  684.  
  685. #else
  686.  
  687.     movl    PVM0_REG,PDEC(SP)
  688.     lea    PC_IND(ret),PVM0_REG
  689.     movl    CONST(0),ATEMP1
  690.     jmp    IND(ATEMP1)    /* jump to ###_kernel.touch */
  691. RETURN(ret,1,1):
  692.     movl    PINC(SP),PVM0_REG
  693. LBL(determined):
  694.     btst    DTEMP1,PLACEHOLDER_REG
  695.     BNES(    touched)
  696.     movl    DTEMP1,ATEMP2
  697.     BRAS(    touch)
  698. LBL(touched):
  699.  
  700. #endif
  701.  
  702.     jmp    IND(PVM0_REG)
  703.  
  704. CONSTS(1)
  705. PRIMITIVE("###_kernel.touch")
  706. END
  707.  
  708. /*---------------------------------------------------------------------------*/
  709.  
  710. #undef LBL
  711. #define LBL(x)MAKE_LBL(03,x)
  712.  
  713. BEGIN("###_kernel.trap_2")
  714.  
  715. /* touch d1 */
  716.  
  717.     GET_TRAP_RETURN(0)
  718.     movl    DTEMP1,PVM0_REG
  719.  
  720. LBL(touch):
  721.     movl    PVM1_REG,ATEMP2
  722.     movl    DISP(ATEMP2,SLOT(PH_VALUE)-SCM_type_PLACEHOLDER),PVM1_REG
  723.     CMPL(    ATEMP2,PVM1_REG)
  724.     BNES(    determined)
  725.  
  726.     LOG(EVENT_TOUCH_UNDET,log1)
  727.  
  728. #ifdef DETERMINE_IS_STRICT
  729.  
  730.     movl    CONST(0),ATEMP1
  731.     jmp    IND(ATEMP1)    /* jump to ###_kernel.touch */
  732. LBL(determined):
  733.  
  734. #else
  735.  
  736.     movl    PVM0_REG,PDEC(SP)
  737.     lea    PC_IND(ret),PVM0_REG
  738.     movl    CONST(0),ATEMP1
  739.     jmp    IND(ATEMP1)    /* jump to ###_kernel.touch */
  740. RETURN(ret,1,1):
  741.     movl    PINC(SP),PVM0_REG
  742. LBL(determined):
  743.     btst    PVM1_REG,PLACEHOLDER_REG
  744.     BEQS(    touch)
  745.  
  746. #endif
  747.  
  748.     jmp    IND(PVM0_REG)
  749.  
  750. CONSTS(1)
  751. PRIMITIVE("###_kernel.touch")
  752. END
  753.  
  754. /*---------------------------------------------------------------------------*/
  755.  
  756. #undef LBL
  757. #define LBL(x)MAKE_LBL(04,x)
  758.  
  759. BEGIN("###_kernel.trap_3")
  760.  
  761. /* touch d2 */
  762.  
  763.     GET_TRAP_RETURN(0)
  764.     movl    DTEMP1,PVM0_REG
  765.  
  766. LBL(touch):
  767.     movl    PVM2_REG,ATEMP2
  768.     movl    DISP(ATEMP2,SLOT(PH_VALUE)-SCM_type_PLACEHOLDER),PVM2_REG
  769.     CMPL(    ATEMP2,PVM2_REG)
  770.     BNES(    determined)
  771.  
  772.     LOG(EVENT_TOUCH_UNDET,log1)
  773.  
  774. #ifdef DETERMINE_IS_STRICT
  775.  
  776.     movl    CONST(0),ATEMP1
  777.     jmp    IND(ATEMP1)    /* jump to ###_kernel.touch */
  778. LBL(determined):
  779.  
  780. #else
  781.  
  782.     movl    PVM0_REG,PDEC(SP)
  783.     lea    PC_IND(ret),PVM0_REG
  784.     movl    CONST(0),ATEMP1
  785.     jmp    IND(ATEMP1)    /* jump to ###_kernel.touch */
  786. RETURN(ret,1,1):
  787.     movl    PINC(SP),PVM0_REG
  788. LBL(determined):
  789.     btst    PVM2_REG,PLACEHOLDER_REG
  790.     BEQS(    touch)
  791.  
  792. #endif
  793.  
  794.     jmp    IND(PVM0_REG)
  795.  
  796. CONSTS(1)
  797. PRIMITIVE("###_kernel.touch")
  798. END
  799.  
  800. /*---------------------------------------------------------------------------*/
  801.  
  802. #undef LBL
  803. #define LBL(x)MAKE_LBL(05,x)
  804.  
  805. BEGIN("###_kernel.trap_4")
  806.  
  807. /* touch d3 */
  808.  
  809.     GET_TRAP_RETURN(0)
  810.     movl    DTEMP1,PVM0_REG
  811.  
  812. LBL(touch):
  813.     movl    PVM3_REG,ATEMP2
  814.     movl    DISP(ATEMP2,SLOT(PH_VALUE)-SCM_type_PLACEHOLDER),PVM3_REG
  815.     CMPL(    ATEMP2,PVM3_REG)
  816.     BNES(    determined)
  817.  
  818.     LOG(EVENT_TOUCH_UNDET,log1)
  819.  
  820. #ifdef DETERMINE_IS_STRICT
  821.  
  822.     movl    CONST(0),ATEMP1
  823.     jmp    IND(ATEMP1)    /* jump to ###_kernel.touch */
  824. LBL(determined):
  825.  
  826. #else
  827.  
  828.     movl    PVM0_REG,PDEC(SP)
  829.     lea    PC_IND(ret),PVM0_REG
  830.     movl    CONST(0),ATEMP1
  831.     jmp    IND(ATEMP1)    /* jump to ###_kernel.touch */
  832. RETURN(ret,1,1):
  833.     movl    PINC(SP),PVM0_REG
  834. LBL(determined):
  835.     btst    PVM3_REG,PLACEHOLDER_REG
  836.     BEQS(    touch)
  837.  
  838. #endif
  839.  
  840.     jmp    IND(PVM0_REG)
  841.  
  842. CONSTS(1)
  843. PRIMITIVE("###_kernel.touch")
  844. END
  845.  
  846. /*---------------------------------------------------------------------------*/
  847.  
  848. #undef LBL
  849. #define LBL(x)MAKE_LBL(06,x)
  850.  
  851. BEGIN("###_kernel.trap_5")
  852.  
  853. /* touch d4 */
  854.  
  855.     GET_TRAP_RETURN(0)
  856.     movl    DTEMP1,PVM0_REG
  857.  
  858. LBL(touch):
  859.     movl    PVM4_REG,ATEMP2
  860.     movl    DISP(ATEMP2,SLOT(PH_VALUE)-SCM_type_PLACEHOLDER),PVM4_REG
  861.     CMPL(    ATEMP2,PVM4_REG)
  862.     BNES(    determined)
  863.  
  864.     LOG(EVENT_TOUCH_UNDET,log1)
  865.  
  866. #ifdef DETERMINE_IS_STRICT
  867.  
  868.     movl    CONST(0),ATEMP1
  869.     jmp    IND(ATEMP1)    /* jump to ###_kernel.touch */
  870. LBL(determined):
  871.  
  872. #else
  873.  
  874.     movl    PVM0_REG,PDEC(SP)
  875.     lea    PC_IND(ret),PVM0_REG
  876.     movl    CONST(0),ATEMP1
  877.     jmp    IND(ATEMP1)    /* jump to ###_kernel.touch */
  878. RETURN(ret,1,1):
  879.     movl    PINC(SP),PVM0_REG
  880. LBL(determined):
  881.     btst    PVM4_REG,PLACEHOLDER_REG
  882.     BEQS(    touch)
  883.  
  884. #endif
  885.  
  886.     jmp    IND(PVM0_REG)
  887.  
  888. CONSTS(1)
  889. PRIMITIVE("###_kernel.touch")
  890. END
  891.  
  892. /*---------------------------------------------------------------------------*/
  893.  
  894. #undef LBL
  895. #define LBL(x)MAKE_LBL(07,x)
  896.  
  897. BEGIN("###_kernel.trap_6")
  898.  
  899. /* non_proc_jump */
  900.  
  901.     MOVE_ARGS_TO_STACK(DTEMP1)
  902.  
  903. /* make room for 'procedure' argument */
  904.  
  905.     movw    DTEMP1,PVM1_REG
  906.     movl    SP,ATEMP2
  907.     subql    IMM(4),SP
  908.     BRAS(    loop_entry)
  909. LBL(loop):
  910.     movl    PINC(ATEMP2),DISP(ATEMP2,-8)
  911. LBL(loop_entry):
  912.     DBRA(    PVM1_REG,loop)
  913.  
  914.     movl    ATEMP1,DISP(ATEMP2,-4)    /* put 'procedure' argument */
  915.     addqw    IMM(1),DTEMP1
  916.  
  917.     movl    CONST(0),ATEMP1    /* apply ##exception.non-proc-jump */
  918.     movl    CONST(1),ATEMP2
  919.     jmp    IND(ATEMP2)
  920.  
  921. CONSTS(2)
  922. PRIMITIVE("##exception.non-proc-jump")
  923. PRIMITIVE("###_kernel.apply")
  924. END
  925.  
  926. /*---------------------------------------------------------------------------*/
  927.  
  928. #undef LBL
  929. #define LBL(x)MAKE_LBL(08,x)
  930.  
  931. BEGIN("###_kernel.trap_7")
  932.  
  933. /* rest_params */
  934.  
  935.     movl    PINC(SP),ATEMP1
  936.  
  937.     MOVE_ARGS_TO_STACK(DTEMP1)
  938.  
  939. /* we know that nb-args < min or nb-args >= nb-parms */
  940.  
  941.     CMPW(    IND(ATEMP1),DTEMP1)    /* nb-args < min ? */
  942.     BLTS(    too_few_args)
  943.  
  944. /* build rest parameter */
  945.  
  946.     movl    NULL_REG,PVM1_REG    /* PVM1_REG = () */
  947.     subw    DISP(ATEMP1,2),DTEMP1    /* DTEMP1 = nb of extra args */
  948.     subqw    IMM(1),DTEMP1
  949.  
  950. LBL(next_arg):
  951.     movl    PINC(SP),PDEC(HEAP_REG)    /* cons up the rest parameter list */
  952.     movl    PVM1_REG,PDEC(HEAP_REG)    /* NOTE: no overflow possible due to */
  953.     movl    HEAP_REG,PVM1_REG    /* limit on number of arguments */
  954.     addql    IMM(4),PVM1_REG
  955.     DBRA(    DTEMP1,next_arg)
  956.  
  957.     movw    DISP(ATEMP1,2),DTEMP1    /* get nb_parms-1 */
  958.     BEQS(    return_parms)        /* if 1 parm, parms are ok */
  959.     movl    PVM1_REG,PVM2_REG    /* else, must shuffle parameters */
  960.     subqw    IMM(1),DTEMP1
  961.     BEQS(    setup_parm1)        /* if 2 parms, only 1 parm to move */
  962.     movl    PVM1_REG,PVM3_REG    /* rest parameter is in reg(3) */
  963.     movl    PINC(SP),PVM2_REG    /* next to last parameter in reg(2) */
  964.  
  965. LBL(setup_parm1):
  966.     movl    PINC(SP),PVM1_REG
  967.  
  968. LBL(return_parms):
  969.     jmp    DISP(ATEMP1,6)        /* return from trap */
  970.  
  971. /* signal error */
  972.  
  973. LBL(too_few_args):
  974.     addql    IMM(4),ATEMP1
  975.     movw    IND(ATEMP1),PVM1_REG
  976.     extl    PVM1_REG
  977.     addl    PVM1_REG,ATEMP1
  978.  
  979.     movl    CONST(0),ATEMP2    /* jump to ###_kernel.wrong-nb-arg */
  980.     jmp    IND(ATEMP2)
  981.  
  982. CONSTS(1)
  983. PRIMITIVE("###_kernel.wrong-nb-arg")
  984. END
  985.  
  986. /*---------------------------------------------------------------------------*/
  987.  
  988. #undef LBL
  989. #define LBL(x)MAKE_LBL(09,x)
  990.  
  991. BEGIN("###_kernel.trap_8")
  992.  
  993. /* rest_params_closed */
  994.  
  995.     movl    PINC(SP),ATEMP1
  996.  
  997.     MOVE_ARGS_TO_STACK(DTEMP1)
  998.  
  999. /* we know that nb-args < min or nb-args >= nb-parms */
  1000.  
  1001.     CMPW(    IND(ATEMP1),DTEMP1)    /* nb-args < min ? */
  1002.     BLTS(    too_few_args)
  1003.  
  1004. /* build rest parameter */
  1005.  
  1006.     movl    NULL_REG,PVM1_REG    /* PVM1_REG = () */
  1007.     subw    DISP(ATEMP1,2),DTEMP1    /* DTEMP1 = nb of extra args */
  1008.     subqw    IMM(1),DTEMP1
  1009.  
  1010. LBL(next_arg):
  1011.     movl    PINC(SP),PDEC(HEAP_REG)    /* cons up the rest parameter list */
  1012.     movl    PVM1_REG,PDEC(HEAP_REG)    /* NOTE: no overflow possible due to */
  1013.     movl    HEAP_REG,PVM1_REG    /* limit on number of arguments */
  1014.     addql    IMM(4),PVM1_REG
  1015.     DBRA(    DTEMP1,next_arg)
  1016.  
  1017.     movw    DISP(ATEMP1,2),DTEMP1    /* get nb_parms-1 */
  1018.     BEQS(    return_parms)        /* if 1 parm, parms are ok */
  1019.     movl    PVM1_REG,PVM2_REG    /* else, must shuffle parameters */
  1020.     subqw    IMM(1),DTEMP1
  1021.     BEQS(    setup_parm1)        /* if 2 parms, only 1 parm to move */
  1022.     movl    PVM1_REG,PVM3_REG    /* rest parameter is in reg(3) */
  1023.     movl    PINC(SP),PVM2_REG    /* next to last parameter in reg(2) */
  1024.  
  1025. LBL(setup_parm1):
  1026.     movl    PINC(SP),PVM1_REG
  1027.  
  1028. LBL(return_parms):
  1029.     jmp    DISP(ATEMP1,4)        /* return from trap */
  1030.  
  1031. /* signal error */
  1032.  
  1033. LBL(too_few_args):
  1034.     movl    PVM4_REG,ATEMP1
  1035.  
  1036.     movl    CONST(0),ATEMP2    /* jump to ###_kernel.wrong-nb-arg */
  1037.     jmp    IND(ATEMP2)
  1038.  
  1039. CONSTS(1)
  1040. PRIMITIVE("###_kernel.wrong-nb-arg")
  1041. END
  1042.  
  1043. /*---------------------------------------------------------------------------*/
  1044.  
  1045. #undef LBL
  1046. #define LBL(x)MAKE_LBL(10,x)
  1047.  
  1048. BEGIN("###_kernel.trap_9")
  1049.  
  1050. /* wrong_nb_arg1 */
  1051.  
  1052.     movl    DTEMP1,ATEMP2
  1053.  
  1054.     movl    PINC(SP),ATEMP1        /* get pointer to procedure */
  1055.     addql    IMM(2),ATEMP1
  1056.     movw    IND(ATEMP1),DTEMP1
  1057.     extl    DTEMP1
  1058.     addl    DTEMP1,ATEMP1
  1059.  
  1060.     MOVE_ARGS_TO_STACK(ATEMP2)
  1061.  
  1062.     movl    CONST(0),ATEMP2    /* jump to ###_kernel.wrong-nb-arg */
  1063.     jmp    IND(ATEMP2)
  1064.  
  1065. CONSTS(1)
  1066. PRIMITIVE("###_kernel.wrong-nb-arg")
  1067. END
  1068.  
  1069. /*---------------------------------------------------------------------------*/
  1070.  
  1071. #undef LBL
  1072. #define LBL(x)MAKE_LBL(11,x)
  1073.  
  1074. BEGIN("###_kernel.trap_10")
  1075.  
  1076. /* wrong_nb_arg1_closed */
  1077.  
  1078.     movl    CLOSURE_REG,ATEMP1
  1079.     addql    IMM(4),SP        /* discard trap address */
  1080.  
  1081.     MOVE_ARGS_TO_STACK(DTEMP1)
  1082.  
  1083.     movl    CONST(0),ATEMP2    /* jump to ###_kernel.wrong-nb-arg */
  1084.     jmp    IND(ATEMP2)
  1085.  
  1086. CONSTS(1)
  1087. PRIMITIVE("###_kernel.wrong-nb-arg")
  1088. END
  1089.  
  1090. /*---------------------------------------------------------------------------*/
  1091.  
  1092. #undef LBL
  1093. #define LBL(x)MAKE_LBL(12,x)
  1094.  
  1095. BEGIN("###_kernel.trap_11")
  1096.  
  1097. /* wrong_nb_arg2 */
  1098.  
  1099.     movl    DTEMP1,ATEMP2
  1100.  
  1101.     movl    PINC(SP),ATEMP1        /* get pointer to procedure */
  1102.     addql    IMM(4),ATEMP1
  1103.     movw    IND(ATEMP1),DTEMP1
  1104.     extl    DTEMP1
  1105.     addl    DTEMP1,ATEMP1
  1106.  
  1107.     MOVE_ARGS_TO_STACK(ATEMP2)
  1108.  
  1109.     movl    CONST(0),ATEMP2    /* jump to ###_kernel.wrong-nb-arg */
  1110.     jmp    IND(ATEMP2)
  1111.  
  1112. CONSTS(1)
  1113. PRIMITIVE("###_kernel.wrong-nb-arg")
  1114. END
  1115.  
  1116. /*---------------------------------------------------------------------------*/
  1117.  
  1118. #undef LBL
  1119. #define LBL(x)MAKE_LBL(13,x)
  1120.  
  1121. BEGIN("###_kernel.trap_12")
  1122.  
  1123. /* wrong_nb_arg2_closed */
  1124.  
  1125.     movl    CLOSURE_REG,ATEMP1
  1126.     addql    IMM(4),SP        /* discard trap address */
  1127.  
  1128.     MOVE_ARGS_TO_STACK(DTEMP1)
  1129.  
  1130.     movl    CONST(0),ATEMP2    /* jump to ###_kernel.wrong-nb-arg */
  1131.     jmp    IND(ATEMP2)
  1132.  
  1133. CONSTS(1)
  1134. PRIMITIVE("###_kernel.wrong-nb-arg")
  1135. END
  1136.  
  1137. /*---------------------------------------------------------------------------*/
  1138.  
  1139. #undef LBL
  1140. #define LBL(x)MAKE_LBL(14,x)
  1141.  
  1142. BEGIN("###_kernel.trap_13")
  1143.  
  1144. /* heap_alloc1 */
  1145.  
  1146.     moveq    IMM(0),DTEMP1
  1147.  
  1148.     movl    CONST(0),ATEMP2        /* jump to ###_kernel.trap_14 */
  1149.     jmp    IND(ATEMP2)
  1150.  
  1151. CONSTS(1)
  1152. PRIMITIVE("###_kernel.trap_14")
  1153. END
  1154.  
  1155. /*---------------------------------------------------------------------------*/
  1156.  
  1157. #undef LBL
  1158. #define LBL(x)MAKE_LBL(15,x)
  1159.  
  1160. BEGIN("###_kernel.trap_14")
  1161.  
  1162. /* heap_alloc2 */
  1163.  
  1164.     addl    DTEMP1,HEAP_REG        /* restore correct heap ptr */
  1165.     movl    DTEMP1,ATEMP2
  1166.  
  1167.     GET_TRAP_RETURN(0)
  1168.     movl    DTEMP1,PDEC(SP)
  1169.  
  1170.     movl    PVM0_REG,PDEC(SP)
  1171.     movl    PVM1_REG,PDEC(SP)
  1172.     movl    PVM2_REG,PDEC(SP)
  1173.     movl    PVM3_REG,PDEC(SP)
  1174.     movl    PVM4_REG,PDEC(SP)
  1175.     movl    ATEMP2,PDEC(SP)
  1176.     BRAS(    gc_and_allocate)
  1177.  
  1178. RETURN(gc_and_allocate,7,1):
  1179.  
  1180.     lea    PC_IND(ret),PVM0_REG
  1181.     movl    CONST(0),ATEMP1    /* jump to ##gc */
  1182.     moveq    IMM(1),DTEMP1    /* passing 0 argument */
  1183.     jmp    IND(ATEMP1)
  1184. RETURN(ret,7,1):
  1185.  
  1186. /* Is there a heap overflow with the current heap margin? */
  1187.  
  1188.     movl    PINC(SP),DTEMP1
  1189.  
  1190.     CMPL(    DTEMP1,HEAP_REG)
  1191.     subl    DTEMP1,HEAP_REG    /* allocate space and check heap overflow */
  1192.     BCSS(    overflow_on_alloc)
  1193.     CMPL(    DISP(PSTATE_REG,SLOT(HEAP_LIM)),HEAP_REG)
  1194.     BCCS(    allocated)
  1195. LBL(overflow_on_alloc):
  1196.     addl    DTEMP1,HEAP_REG    /* restore correct heap ptr */
  1197.  
  1198. /* Then use a smaller heap margin and signal a heap overflow */
  1199.  
  1200.     movl    DISP(PSTATE_REG,SLOT(HEAP_MARGIN)),DTEMP1
  1201.     BEQS(    fatal_overflow)
  1202.  
  1203.     subl    DTEMP1,DISP(PSTATE_REG,SLOT(HEAP_LIM))
  1204.     moveq    IMM(0),DTEMP1
  1205.     movl    DTEMP1,DISP(PSTATE_REG,SLOT(HEAP_MARGIN))
  1206.  
  1207. /* continuation must be discarded... */
  1208.  
  1209.     movl    DISP(PSTATE_REG,SLOT(BOS_RET)),PVM0_REG
  1210.  
  1211.     movl    CONST(1),ATEMP1    /* jump to ##exception.heap-overflow proc */
  1212.     moveq    IMM(1),DTEMP1    /* passing 0 argument */
  1213.     jmp    IND(ATEMP1)
  1214.  
  1215. LBL(fatal_overflow):
  1216.  
  1217.     movl    DISP(PSTATE_REG,SLOT(BOS_RET)),PVM0_REG
  1218.  
  1219.     movl    CONST(2),ATEMP1
  1220.     moveq    IMM(1),DTEMP1
  1221.     jmp    IND(ATEMP1)
  1222.  
  1223. LBL(allocated):
  1224.  
  1225. /* Check to see if we can grow the heap margin */
  1226.  
  1227.     movl    DISP(PSTATE_REG,SLOT(HEAP_LIM)),DTEMP1
  1228.     subl    DISP(PSTATE_REG,SLOT(HEAP_MARGIN)),DTEMP1
  1229.     addl    DISP(PSTATE_REG,SLOT(HEAP_MAX_MARGIN)),DTEMP1
  1230.     CMPL(    DTEMP1,HEAP_REG)
  1231.     BCSS(    cant_grow)
  1232.  
  1233.     movl    DTEMP1,DISP(PSTATE_REG,SLOT(HEAP_LIM))
  1234.     movl    DISP(PSTATE_REG,SLOT(HEAP_MAX_MARGIN)),DISP(PSTATE_REG,SLOT(HEAP_MARGIN))
  1235.  
  1236. LBL(cant_grow):
  1237.     movl    PINC(SP),PVM4_REG
  1238.     movl    PINC(SP),PVM3_REG
  1239.     movl    PINC(SP),PVM2_REG
  1240.     movl    PINC(SP),PVM1_REG
  1241.     movl    PINC(SP),PVM0_REG
  1242.     rts
  1243.  
  1244. CONSTS(3)
  1245. PRIMITIVE("##gc")
  1246. PRIMITIVE("##exception.heap-overflow")
  1247. PRIMITIVE("##fatal-heap-overflow")
  1248. END
  1249.  
  1250. /*---------------------------------------------------------------------------*/
  1251.  
  1252. #undef LBL
  1253. #define LBL(x)MAKE_LBL(16,x)
  1254.  
  1255. BEGIN("###_kernel.trap_15")
  1256.  
  1257. /* closure_alloc */
  1258.  
  1259.     movl    DTEMP1,ATEMP2
  1260.  
  1261.     GET_TRAP_RETURN(0)
  1262.     movl    DTEMP1,PDEC(SP)
  1263.  
  1264.     movl    ATEMP2,DTEMP1
  1265.     movl    DTEMP1,PDEC(SP)
  1266.  
  1267.     addl    IMM(CLOSURE_BLOCK_LENGTH+CACHE_LINE_LENGTH),DTEMP1
  1268.     subl    DTEMP1,HEAP_REG
  1269.     CMPL(    DISP(PSTATE_REG,SLOT(HEAP_LIM)),HEAP_REG) /* heap overflow */
  1270.     BCCS(    ok)
  1271.  
  1272.     TRAP(heap_alloc2_trap,alloc,2,1)
  1273.  
  1274. LBL(ok):
  1275.     movl    HEAP_REG,DTEMP1
  1276.     addl    IMM(CACHE_LINE_LENGTH),DTEMP1
  1277.     andw    IMM(-CACHE_LINE_LENGTH),DTEMP1
  1278.     movl    DTEMP1,ATEMP1
  1279.     movl    ATEMP1,DISP(PSTATE_REG,SLOT(CLOSURE_LIM))
  1280.     addl    IMM(CLOSURE_BLOCK_LENGTH),ATEMP1
  1281.     movl    ATEMP1,DISP(PSTATE_REG,SLOT(CLOSURE_PTR))
  1282.  
  1283.     addl    PINC(SP),ATEMP1
  1284.  
  1285. /* init closure block: */
  1286.  
  1287.     movl    IMM(0x80080000+JSR_OP),DTEMP1
  1288.     lea    PC_IND(closure_trampoline),ATEMP2
  1289.     BRAS(    loop_entry)
  1290. LBL(loop):
  1291.     subql    IMM(CACHE_LINE_LENGTH-8),ATEMP1
  1292.     movl    ATEMP2,PDEC(ATEMP1)
  1293.     movl    DTEMP1,PDEC(ATEMP1)
  1294. LBL(loop_entry):
  1295.     CMPL(    ATEMP1,HEAP_REG)
  1296.     BLTS(    loop)
  1297.  
  1298.     movl    DISP(PSTATE_REG,SLOT(FLUSH_WRITES)),PDEC(SP)
  1299.     jsr    DISP(TABLE_REG,TRAP_OFFS(C_TRAP_trap))
  1300.  
  1301.     movl    DISP(PSTATE_REG,SLOT(CLOSURE_PTR)),ATEMP2
  1302.  
  1303.     rts
  1304.  
  1305. LBL(closure_trampoline):
  1306.     movl    IND(SP),ATEMP1
  1307.     movl    PDEC(ATEMP1),ATEMP1
  1308.     jmp    IND(ATEMP1)
  1309.  
  1310. CONSTS(0)
  1311. END
  1312.  
  1313. /*---------------------------------------------------------------------------*/
  1314.  
  1315. #undef LBL
  1316. #define LBL(x)MAKE_LBL(17,x)
  1317.  
  1318. BEGIN("###_kernel.trap_16")
  1319.  
  1320. /* delay_future */
  1321.  
  1322.     GET_TRAP_RETURN(0)
  1323.     movl    DTEMP1,PVM0_REG
  1324.  
  1325. /* Allocate special "DELAY" frame. */
  1326.  
  1327.     moveq    IMM(11+4+PH_SIZE*4),DTEMP1
  1328.     addw    DISP(PVM0_REG,-6),DTEMP1    /* get fs */
  1329.     andw    IMM(-8),DTEMP1
  1330.     subl    DTEMP1,HEAP_REG
  1331.  
  1332. /* Check need to GC. */
  1333.  
  1334.     CMPL(    DISP(PSTATE_REG,SLOT(HEAP_LIM)),HEAP_REG)
  1335.     BCCS(    space_allocated)
  1336. LBL(gc_needed):
  1337.     movl    PVM0_REG,PDEC(SP)
  1338.     TRAP(heap_alloc2_trap,alloc,1,1)
  1339.     movl    PINC(SP),PVM0_REG
  1340.  
  1341. LBL(space_allocated):
  1342.     addw    IMM(PH_SIZE*4),HEAP_REG
  1343.  
  1344.     moveq    IMM(4),DTEMP1
  1345.     addw    DISP(PVM0_REG,-6),DTEMP1
  1346.     asll    IMM(8),DTEMP1
  1347.     movb    IMM(SCM_subtype_VECTOR*8),DTEMP1
  1348.     movl    DTEMP1,IND(HEAP_REG)
  1349.  
  1350. /* Copy the frame. */
  1351.  
  1352.     lsrl    IMM(8),DTEMP1
  1353.     lsrl    IMM(2),DTEMP1
  1354.     subql    IMM(2),DTEMP1
  1355.  
  1356.     moveq    IMM(0),PVM1_REG
  1357.     movw    DISP(PVM0_REG,-4),PVM1_REG    /* get link */
  1358.     movl    INXW(SP,PVM1_REG,0),ATEMP2
  1359.  
  1360.     lea    DISP(HEAP_REG,SLOT(1)),ATEMP1
  1361.     movl    PVM0_REG,PINC(ATEMP1)
  1362. LBL(copy_loop):
  1363.     movl    PINC(SP),PINC(ATEMP1)
  1364.     DBRA(    DTEMP1,copy_loop)
  1365.  
  1366. /* Make placeholder. */
  1367.  
  1368.     lea    DISP(HEAP_REG,SCM_type_SUBTYPED),ATEMP1
  1369.     clrl    PDEC(HEAP_REG)
  1370.     movl    ATEMP1,PDEC(HEAP_REG)
  1371.     movl    NULL_REG,PDEC(HEAP_REG)
  1372.     lea    DISP(HEAP_REG,SCM_type_PLACEHOLDER-4),ATEMP1
  1373.     movl    ATEMP1,PDEC(HEAP_REG)
  1374.  
  1375. /* Return placeholder. */
  1376.  
  1377.     movl    ATEMP1,PVM1_REG
  1378.  
  1379.     jmp    IND(ATEMP2)
  1380.  
  1381. CONSTS(0)
  1382. END
  1383.  
  1384. /*---------------------------------------------------------------------------*/
  1385.  
  1386. #undef LBL
  1387. #define LBL(x)MAKE_LBL(18,x)
  1388.  
  1389. BEGIN("###_kernel.trap_17")
  1390.  
  1391. /* eager_future */
  1392.  
  1393.     GET_TRAP_RETURN(0)
  1394.     movl    DTEMP1,PVM0_REG
  1395.  
  1396. /* broken... */
  1397.  
  1398.     jmp    IND(PVM0_REG)
  1399.  
  1400. CONSTS(0)
  1401. END
  1402.  
  1403. /*---------------------------------------------------------------------------*/
  1404.  
  1405. #undef LBL
  1406. #define LBL(x)MAKE_LBL(19,x)
  1407.  
  1408. BEGIN("###_kernel.trap_18")
  1409.  
  1410. /* steal_conflict */
  1411.  
  1412.     GET_TRAP_RETURN(0)
  1413.     movl    DTEMP1,ATEMP2
  1414.  
  1415. /* get consistent value for LTQ_HEAD */
  1416.  
  1417.     movl    FALSE_REG,DISP(PSTATE_REG,SLOT(STEAL_LOCKO))
  1418.  
  1419. /*
  1420.     tstl    DISP(PSTATE_REG,SLOT(STEAL_LOCKV))
  1421.     BEQS(    locked)
  1422.  
  1423.     addql    IMM(8),DISP(PSTATE_REG,SLOT(56))
  1424. */
  1425.  
  1426. LBL(lock_steal):
  1427.     tstl    DISP(PSTATE_REG,SLOT(STEAL_LOCKV))
  1428.     BNES(    lock_steal)
  1429. LBL(locked):
  1430.  
  1431.     movl    DISP(PSTATE_REG,SLOT(LTQ_HEAD)),ATEMP1
  1432.  
  1433.     clrl    DISP(PSTATE_REG,SLOT(STEAL_LOCKO))
  1434.  
  1435. /* Who won the race for the continuation? */
  1436.  
  1437.     CMPL(    ATEMP1,LTQ_TAIL_REG)
  1438.     BCSS(    thief_won)
  1439.  
  1440. /* Continue normally */
  1441.  
  1442.     jmp    IND(ATEMP2)
  1443.  
  1444. LBL(thief_won):
  1445.  
  1446.     movl    SP,PINC(LTQ_TAIL_REG)
  1447.  
  1448.     movl    CONST(0),ATEMP1
  1449.     addw    IMM(16),ATEMP1
  1450.     movl    ATEMP1,DISP(PSTATE_REG,SLOT(PARENT_RET))
  1451.  
  1452. #ifdef debug
  1453. /*****/    pea    PC_IND($entry)
  1454. /*****/    movl    PINC(SP),DISP(PSTATE_REG,SLOT(56))
  1455. /*****/    movl    IMM(0),DISP(PSTATE_REG,SLOT(57))
  1456. /*****/    movl    IMM(0),DISP(PSTATE_REG,SLOT(58))
  1457. #endif
  1458.  
  1459.     movl    DISP(PSTATE_REG,SLOT(BOS_RET)),ATEMP1
  1460.     jmp    IND(ATEMP1)
  1461.  
  1462. CONSTS(1)
  1463. PRIMITIVE("###_kernel.task")
  1464. END
  1465.  
  1466. /*---------------------------------------------------------------------------*/
  1467.  
  1468. #undef LBL
  1469. #define LBL(x)MAKE_LBL(20,x)
  1470.  
  1471. BEGIN("###_kernel.trap_19")
  1472.  
  1473.     BRAS(    $entry)
  1474.  
  1475. CONSTS(0)
  1476. END
  1477.  
  1478. /*---------------------------------------------------------------------------*/
  1479.  
  1480. #undef LBL
  1481. #define LBL(x)MAKE_LBL(21,x)
  1482.  
  1483. BEGIN("###_kernel.trap_20")
  1484.  
  1485.     BRAS(    $entry)
  1486.  
  1487. CONSTS(0)
  1488. END
  1489.  
  1490. /*---------------------------------------------------------------------------*/
  1491.  
  1492. #undef LBL
  1493. #define LBL(x)MAKE_LBL(22,x)
  1494.  
  1495. BEGIN("###_kernel.trap_21")
  1496.  
  1497.     BRAS(    $entry)
  1498.  
  1499. CONSTS(0)
  1500. END
  1501.  
  1502. /*---------------------------------------------------------------------------*/
  1503.  
  1504. #undef LBL
  1505. #define LBL(x)MAKE_LBL(23,x)
  1506.  
  1507. BEGIN("###_kernel.trap_22")
  1508.  
  1509. /* C_TRAP */
  1510.  
  1511.     movl    REG(a4),PDEC(SP)
  1512.     movl    REG(a3),PDEC(SP)
  1513.     movl    REG(a2),PDEC(SP)
  1514.     movl    REG(a1),PDEC(SP)
  1515.     movl    REG(a0),PDEC(SP)
  1516.     movl    DISP(SP,4+SLOT(5)),REG(a0)
  1517.     movl    REG(d7),PDEC(SP)
  1518.     movl    REG(d6),PDEC(SP)
  1519.     movl    REG(d5),PDEC(SP)
  1520.     movl    REG(d4),PDEC(SP)
  1521.     movl    REG(d3),PDEC(SP)
  1522.     movl    REG(d2),PDEC(SP)
  1523.     movl    REG(d1),PDEC(SP)
  1524.     movl    REG(d0),PDEC(SP)
  1525.  
  1526.     movl    SP,DISP(PSTATE_REG,SLOT(STACK_PTR))
  1527.  
  1528.     movl    CONST(0),REG(a1)        /* restore C's registers */
  1529. #ifndef MIN_C_CONTEXT
  1530.     movl    DISP(REG(a1),C_D2),REG(d2)
  1531.     movl    DISP(REG(a1),C_D3),REG(d3)
  1532.     movl    DISP(REG(a1),C_D4),REG(d4)
  1533.     movl    DISP(REG(a1),C_D5),REG(d5)
  1534.     movl    DISP(REG(a1),C_D6),REG(d6)
  1535.     movl    DISP(REG(a1),C_D7),REG(d7)
  1536.     movl    DISP(REG(a1),C_A2),REG(a2)
  1537.     movl    DISP(REG(a1),C_A3),REG(a3)
  1538.     movl    DISP(REG(a1),C_A4),REG(a4)
  1539. #endif
  1540.     movl    DISP(REG(a1),C_A5),REG(a5)
  1541.     movl    DISP(REG(a1),C_A6),REG(a6)
  1542.     movl    DISP(REG(a1),C_SP),SP
  1543.  
  1544.     jsr    IND(REG(a0))            /* call C procedure */
  1545.  
  1546.     movl    CONST(0),REG(a2)
  1547.     movl    DISP(REG(a2),C_SP),ATEMP1    /* get TABLE_REG & PSTATE_REG */
  1548.     movl    DISP(ATEMP1,4),TABLE_REG    /* restore Scheme context */
  1549.     movl    DISP(ATEMP1,8),PSTATE_REG
  1550.  
  1551.     movl    DISP(PSTATE_REG,SLOT(STACK_PTR)),SP
  1552.  
  1553.     movl    PINC(SP),REG(d0)
  1554.     movl    PINC(SP),REG(d1)
  1555.     movl    PINC(SP),REG(d2)
  1556.     movl    PINC(SP),REG(d3)
  1557.     movl    PINC(SP),REG(d4)
  1558.     movl    PINC(SP),REG(d5)
  1559.     movl    PINC(SP),REG(d6)
  1560.     movl    PINC(SP),REG(d7)
  1561.     movl    PINC(SP),REG(a0)
  1562.     movl    PINC(SP),REG(a1)
  1563.     movl    PINC(SP),REG(a2)
  1564.     movl    PINC(SP),REG(a3)
  1565.     movl    PINC(SP),REG(a4)
  1566.  
  1567.     movl    PINC(SP),IND(SP)
  1568.  
  1569.     rts
  1570.  
  1571. CONSTS(1)
  1572. PRIMITIVE("###_kernel")
  1573. END
  1574.  
  1575. /*---------------------------------------------------------------------------*/
  1576.  
  1577. #undef LBL
  1578. #define LBL(x)MAKE_LBL(24,x)
  1579.  
  1580. BEGIN("###_kernel.trap_23")
  1581.  
  1582. /* C_CALL */
  1583.  
  1584.     movl    CONST(0),REG(a2)
  1585.     movl    DISP(REG(a2),C_SP),ATEMP2
  1586.  
  1587.     movl    IMM(SCM_marker),PDEC(ATEMP2)
  1588.  
  1589.     tstw    DTEMP1
  1590.     BMIS(    passed_1arg)
  1591.     BEQS(    passed_2args)
  1592.  
  1593.     subqw    IMM(3),DTEMP1
  1594.     BMIS(    move_remaining_args)
  1595.  
  1596.     movl    PVM3_REG,PDEC(ATEMP2)
  1597.     subqw    IMM(1),DTEMP1
  1598. LBL(passed_2args):
  1599.     movl    PVM2_REG,PDEC(ATEMP2)
  1600.     subqw    IMM(1),DTEMP1
  1601. LBL(passed_1arg):
  1602.     movl    PVM1_REG,PDEC(ATEMP2)
  1603.     subqw    IMM(1),DTEMP1
  1604.  
  1605. LBL(move_remaining_args):
  1606.     addqw    IMM(2),DTEMP1
  1607.     BRAS(    loop_entry)
  1608. LBL(loop):
  1609.     movl    PINC(SP),PDEC(ATEMP2)
  1610. LBL(loop_entry):
  1611.     DBRA(    DTEMP1,loop)
  1612.  
  1613.     movl    PVM0_REG,PDEC(SP)        /* save Scheme context */
  1614.     pea    PC_IND(default_return_proc)
  1615.  
  1616.     movl    SP,DISP(PSTATE_REG,SLOT(STACK_PTR))
  1617.     movl    LTQ_TAIL_REG,DISP(PSTATE_REG,SLOT(LTQ_TAIL))
  1618.     movl    HEAP_REG,DISP(PSTATE_REG,SLOT(HEAP_PTR))
  1619.  
  1620.     movl    ATEMP2,SP
  1621.  
  1622.     movl    ATEMP1,ATEMP2
  1623.  
  1624.     LOG(EVENT_C_CALL,log1)
  1625.  
  1626.     movl    ATEMP2,REG(a0)
  1627.  
  1628.     movl    CONST(0),REG(a1)        /* restore C's registers */
  1629. #ifndef MIN_C_CONTEXT
  1630.     movl    DISP(REG(a1),C_D2),REG(d2)
  1631.     movl    DISP(REG(a1),C_D3),REG(d3)
  1632.     movl    DISP(REG(a1),C_D4),REG(d4)
  1633.     movl    DISP(REG(a1),C_D5),REG(d5)
  1634.     movl    DISP(REG(a1),C_D6),REG(d6)
  1635.     movl    DISP(REG(a1),C_D7),REG(d7)
  1636.     movl    DISP(REG(a1),C_A2),REG(a2)
  1637.     movl    DISP(REG(a1),C_A3),REG(a3)
  1638.     movl    DISP(REG(a1),C_A4),REG(a4)
  1639. #endif
  1640.     movl    DISP(REG(a1),C_A5),REG(a5)
  1641.     movl    DISP(REG(a1),C_A6),REG(a6)
  1642.  
  1643.     jsr    IND(REG(a0))            /* call C procedure */
  1644.  
  1645.     movl    DTEMP1,PVM1_REG            /* get result */
  1646.  
  1647.     movl    CONST(0),REG(a2)
  1648.     movl    DISP(REG(a2),C_SP),ATEMP1    /* get TABLE_REG & PSTATE_REG */
  1649.     movl    DISP(ATEMP1,4),TABLE_REG    /* restore Scheme context */
  1650.     movl    DISP(ATEMP1,8),PSTATE_REG
  1651.     movl    DISP(PSTATE_REG,SLOT(STACK_PTR)),SP
  1652.     movl    DISP(PSTATE_REG,SLOT(HEAP_PTR)),HEAP_REG
  1653.     movl    DISP(PSTATE_REG,SLOT(LTQ_TAIL)),LTQ_TAIL_REG
  1654.  
  1655.     moveq    IMM(0),INTR_TIMER_REG        /* check interrupts as soon as possible */
  1656.     movl    IMM(SCM_null),NULL_REG
  1657.     movl    IMM(SCM_false),FALSE_REG
  1658.  
  1659.     moveq    IMM(0),PVM2_REG
  1660.     moveq    IMM(0),PVM3_REG
  1661.     moveq    IMM(0),PVM4_REG
  1662.  
  1663.     PREV_LOG(2,log2)
  1664.  
  1665.     movl    PINC(SP),ATEMP1
  1666.     movl    PINC(SP),PVM0_REG
  1667.     moveq    IMM(-1),DTEMP1
  1668.     jmp    IND(ATEMP1)
  1669.  
  1670. SUBPROC(default_return_proc):
  1671.     jmp    IND(PVM0_REG)
  1672.  
  1673. CONSTS(1)
  1674. PRIMITIVE("###_kernel")
  1675. END
  1676.  
  1677. /*---------------------------------------------------------------------------*/
  1678.  
  1679. #undef LBL
  1680. #define LBL(x)MAKE_LBL(25,x)
  1681.  
  1682. BEGIN("###_kernel.interrupt")
  1683.  
  1684. /* intr */
  1685.  
  1686.     GET_TRAP_RET(0)
  1687.     movl    DTEMP1,ATEMP1
  1688.  
  1689. /* Clear interrupt flag. */
  1690.  
  1691.     movl    DISP(PSTATE_REG,SLOT(STACK_LIM)),IND(PSTATE_REG)
  1692.  
  1693. /*vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv*/
  1694. #ifdef MESSAGE_PASSING_STEAL
  1695.  
  1696. /* Check if steal request. */
  1697.  
  1698. #ifdef SYNCHRONOUS_STEAL
  1699.     movl    DISP(PSTATE_REG,SLOT(THIEF)),DTEMP1
  1700.     BEQS(    not_steal)
  1701. #else
  1702.     movl    DISP(PSTATE_REG,SLOT(WORK_REQUEST)),DTEMP1
  1703.     BEQS(    not_steal)
  1704.     clrl    DISP(PSTATE_REG,SLOT(WORK_REQUEST))
  1705. #endif
  1706.  
  1707. /* Check if anything to steal. */
  1708.  
  1709.     CMPL(    DISP(PSTATE_REG,SLOT(LTQ_HEAD)),LTQ_TAIL_REG)
  1710.     BNES(    steal)
  1711.  
  1712. /* Nothing to steal, so immediately respond to steal request. */
  1713.  
  1714. #ifdef SYNCHRONOUS_STEAL
  1715.     clrl    DISP(PSTATE_REG,SLOT(THIEF))
  1716.     clrl    DISP(PSTATE_REG,SLOT(STEAL_LOCKV))
  1717.     movl    DTEMP1,ATEMP2
  1718.     clrl    DISP(ATEMP2,SLOT(RESPONSE))
  1719. #endif
  1720.  
  1721. LBL(not_steal):
  1722.  
  1723. #endif
  1724. /*^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^*/
  1725.  
  1726.     CMPL(    DISP(PSTATE_REG,SLOT(STACK_LIM)),SP)
  1727.     BCSW(    check_other_intrs1)
  1728.  
  1729.     movl    DISP(PSTATE_REG,SLOT(INTR_OTHER)),DTEMP1
  1730.     BNEW(    check_other_intrs1)
  1731.  
  1732. LBL(quick_return):
  1733.     jmp    DISP(ATEMP1,SCM_type_PROCEDURE)
  1734.  
  1735. /*vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv*/
  1736. #ifdef MESSAGE_PASSING_STEAL
  1737.  
  1738. LBL(steal):
  1739.     pea    DISP(ATEMP1,SCM_type_PROCEDURE)
  1740.  
  1741.     LOG(EVENT_INTERRUPT,log1)
  1742.  
  1743.     movl    PVM0_REG,PDEC(SP)
  1744.     movl    PVM1_REG,PDEC(SP)
  1745.     movl    PVM2_REG,PDEC(SP)
  1746.     movl    PVM3_REG,PDEC(SP)
  1747.     movl    PVM4_REG,PDEC(SP)
  1748.  
  1749. LBL(steal_again):
  1750.  
  1751.     movl    DISP(PSTATE_REG,SLOT(LTQ_HEAD)),ATEMP1
  1752.  
  1753.     movl    DISP(ATEMP1,-SLOT(1)),DTEMP1
  1754.     subl    DISP(LTQ_TAIL_REG,-SLOT(1)),DTEMP1
  1755.     addl    IMM((TASK_SIZE+1)+(PH_SIZE*2)+4),DTEMP1
  1756.     asll    IMM(2),DTEMP1
  1757.  
  1758.     CMPL(    DTEMP1,HEAP_REG)
  1759.     subl    DTEMP1,HEAP_REG    /* allocate space for frames and check heap */
  1760.     BCSS(    gc_needed)
  1761.     CMPL(    DISP(PSTATE_REG,SLOT(HEAP_LIM)),HEAP_REG) /* overflow */
  1762.     BCCS(    space_allocated)
  1763. LBL(gc_needed):
  1764.  
  1765. #ifdef SYNCHRONOUS_STEAL
  1766.     movl    DISP(PSTATE_REG,SLOT(THIEF)),ATEMP1
  1767.     clrl    DISP(PSTATE_REG,SLOT(THIEF))
  1768.     clrl    DISP(PSTATE_REG,SLOT(STEAL_LOCKV))
  1769.     clrl    DISP(ATEMP1,SLOT(RESPONSE))
  1770. #endif
  1771.  
  1772.     PREV_LOG(2,log2)
  1773.     TRAP(heap_alloc1_trap,alloc,6,1)
  1774.     LOG(EVENT_INTERRUPT,log3)
  1775.  
  1776.     BRAW(    check_other_intrs2)
  1777.  
  1778. LBL(space_allocated):
  1779.     addl    DTEMP1,HEAP_REG
  1780.  
  1781. /* At this point, we know that there is at least one task on the LTQ and */
  1782. /* that there is enough free space on the heap to copy the frames.       */
  1783.  
  1784. /* Transfer one task chunk to thief (or workq). */
  1785.  
  1786. /* Call ###_kernel.transfer-lazy-task-chunk-to-heap. */
  1787.  
  1788. #ifdef SYNCHRONOUS_STEAL
  1789.     movl    DISP(PSTATE_REG,SLOT(THIEF)),PVM2_REG
  1790.     clrl    DISP(PSTATE_REG,SLOT(THIEF))
  1791.     clrl    DISP(PSTATE_REG,SLOT(STEAL_LOCKV))
  1792. #else
  1793.     moveq    IMM(0),PVM2_REG        /* specify direct transfer to workq */
  1794. #endif
  1795.  
  1796.     movl    DISP(PSTATE_REG,SLOT(LTQ_HEAD)),ATEMP1
  1797.     movl    DISP(ATEMP1,-SLOT(1)),PVM3_REG
  1798.     pea    PC_IND(task_chunk_transferred)
  1799.     movl    CONST(1),ATEMP2
  1800.     jmp    IND(ATEMP2)
  1801. LBL(task_chunk_transferred):
  1802.     moveq    IMM(0),PVM1_REG
  1803.     movl    PVM1_REG,PVM0_REG
  1804.     movl    PVM1_REG,PVM3_REG
  1805.  
  1806. /* Check again if steal request. */
  1807.  
  1808. #ifdef SYNCHRONOUS_STEAL
  1809.     movl    DISP(PSTATE_REG,SLOT(THIEF)),DTEMP1
  1810.     BEQS(    check_other_intrs2)
  1811. #else
  1812.     movl    DISP(PSTATE_REG,SLOT(WORK_REQUEST)),DTEMP1
  1813.     BEQS(    check_other_intrs2)
  1814.     clrl    DISP(PSTATE_REG,SLOT(WORK_REQUEST))
  1815. #endif
  1816.  
  1817. /* Check if anything to steal. */
  1818.  
  1819.     CMPL(    DISP(PSTATE_REG,SLOT(LTQ_HEAD)),LTQ_TAIL_REG)
  1820.     BNEW(    steal_again)
  1821.  
  1822. /* Nothing to steal, so immediately respond to steal request. */
  1823.  
  1824. #ifdef SYNCHRONOUS_STEAL
  1825.     clrl    DISP(PSTATE_REG,SLOT(THIEF))
  1826.     clrl    DISP(PSTATE_REG,SLOT(STEAL_LOCKV))
  1827.     movl    DTEMP1,ATEMP2
  1828.     clrl    DISP(ATEMP2,SLOT(RESPONSE))
  1829. #endif
  1830.  
  1831.     BRAS(    check_other_intrs2)
  1832.  
  1833. #endif
  1834. /*^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^*/
  1835.  
  1836. LBL(check_other_intrs1):
  1837.     pea    DISP(ATEMP1,SCM_type_PROCEDURE)
  1838.  
  1839.     LOG(EVENT_INTERRUPT,log4)
  1840.  
  1841.     movl    PVM0_REG,PDEC(SP)
  1842.     movl    PVM1_REG,PDEC(SP)
  1843.     movl    PVM2_REG,PDEC(SP)
  1844.     movl    PVM3_REG,PDEC(SP)
  1845.     movl    PVM4_REG,PDEC(SP)
  1846.  
  1847. LBL(check_other_intrs2):
  1848.     clrl    DISP(PSTATE_REG,SLOT(INTR_OTHER))
  1849.  
  1850. /* Check if there was a stack overflow. */
  1851.  
  1852.     CMPL(    DISP(PSTATE_REG,SLOT(STACK_LIM)),SP)
  1853.     BCCS(    stack_checked)
  1854.  
  1855.     moveq    IMM(0),DTEMP1
  1856.     movl    DTEMP1,DISP(PSTATE_REG,SLOT(STACK_MARGIN))
  1857.  
  1858.     movl    DISP(PSTATE_REG,SLOT(STACK_BOT)),DTEMP1
  1859.     addl    IMM(SLOT(STACK_ALLOCATION_FUDGE)),DTEMP1
  1860.     addl    DISP(PSTATE_REG,SLOT(STACK_MARGIN)),DTEMP1
  1861.     movl    DTEMP1,DISP(PSTATE_REG,SLOT(STACK_LIM))
  1862.  
  1863.     lea    PC_IND(ret1),PVM0_REG
  1864.     movl    CONST(0),ATEMP1
  1865.     jmp    IND(ATEMP1)
  1866. RETURN(ret1,6,1):
  1867.  
  1868.     movl    DISP(PSTATE_REG,SLOT(STACK_MAX_MARGIN)),DISP(PSTATE_REG,SLOT(STACK_MARGIN))
  1869.  
  1870.     movl    DISP(PSTATE_REG,SLOT(STACK_BOT)),DTEMP1
  1871.     addl    IMM(SLOT(STACK_ALLOCATION_FUDGE)),DTEMP1
  1872.     addl    DISP(PSTATE_REG,SLOT(STACK_MARGIN)),DTEMP1
  1873.     movl    DTEMP1,DISP(PSTATE_REG,SLOT(STACK_LIM))
  1874.  
  1875. LBL(stack_checked):
  1876.  
  1877. /* Check each of the interrupt flags in turn. */
  1878.  
  1879.     tstl    DISP(PSTATE_REG,SLOT(INTR_BARRIER))
  1880.     BEQS(    ret2)
  1881.     clrl    DISP(PSTATE_REG,SLOT(INTR_BARRIER))
  1882.     lea    PC_IND(ret2),PVM0_REG
  1883.     movl    CONST(2),ATEMP1    /* Call ##barrier */
  1884.     moveq    IMM(1),DTEMP1
  1885.     jmp    IND(ATEMP1)
  1886. RETURN(ret2,6,1):
  1887.  
  1888.     tstl    DISP(PSTATE_REG,SLOT(INTR_TIMER))
  1889.     BEQS(    ret3)
  1890.     clrl    DISP(PSTATE_REG,SLOT(INTR_TIMER))
  1891.     lea    PC_IND(ret3),PVM0_REG
  1892.     movl    CONST(3),ATEMP1    /* Call ##exception.timer-interrupt */
  1893.     moveq    IMM(1),DTEMP1
  1894.     jmp    IND(ATEMP1)
  1895. RETURN(ret3,6,1):
  1896.  
  1897.     tstl    DISP(PSTATE_REG,SLOT(INTR_USER))
  1898.     BEQS(    ret4)
  1899.     clrl    DISP(PSTATE_REG,SLOT(INTR_USER))
  1900.     lea    PC_IND(ret4),PVM0_REG
  1901.     movl    CONST(4),ATEMP1    /* Call ##exception.user-interrupt */
  1902.     moveq    IMM(1),DTEMP1
  1903.     jmp    IND(ATEMP1)
  1904. RETURN(ret4,6,1):
  1905.  
  1906.     movl    PINC(SP),PVM4_REG
  1907.     movl    PINC(SP),PVM3_REG
  1908.     movl    PINC(SP),PVM2_REG
  1909.     movl    PINC(SP),PVM1_REG
  1910.     movl    PINC(SP),PVM0_REG
  1911.  
  1912.     PREV_LOG(2,log5)
  1913.  
  1914.     rts
  1915.  
  1916. CONSTS(5)
  1917. PRIMITIVE("###_kernel.flush-stack")
  1918. PRIMITIVE("###_kernel.transfer-lazy-task-chunk-to-heap")
  1919. PRIMITIVE("##barrier")
  1920. PRIMITIVE("##exception.timer-interrupt")
  1921. PRIMITIVE("##exception.user-interrupt")
  1922. END
  1923.  
  1924. /*---------------------------------------------------------------------------*/
  1925.  
  1926. #undef LBL
  1927. #define LBL(x)MAKE_LBL(26,x)
  1928.  
  1929. BEGIN("###_kernel.apply")
  1930.  
  1931.     tstw    DTEMP1            /* how many arguments to pass? */
  1932.     BEQS(    pass_0arg)
  1933.     subqw    IMM(2),DTEMP1
  1934.     BMIS(    pass_1arg)
  1935.     BEQS(    pass_2args)
  1936.  
  1937.     movl    PINC(SP),PVM3_REG
  1938.     movl    PINC(SP),PVM2_REG
  1939.     movl    PINC(SP),PVM1_REG
  1940.     addqw    IMM(3),DTEMP1
  1941.     jmp    IND(ATEMP1)        /* jump to procedure (with >= 3 args) */
  1942.  
  1943. LBL(pass_0arg):
  1944.     moveq    IMM(1),DTEMP1
  1945.     jmp    IND(ATEMP1)        /* jump to procedure (with no arg) */
  1946.  
  1947. LBL(pass_1arg):
  1948.     movl    PINC(SP),PVM1_REG
  1949.     moveq    IMM(-1),DTEMP1
  1950.     jmp    IND(ATEMP1)        /* jump to procedure (with 1 arg) */
  1951.  
  1952. LBL(pass_2args):
  1953.     movl    PINC(SP),PVM2_REG
  1954.     movl    PINC(SP),PVM1_REG
  1955.     moveq    IMM(0),DTEMP1
  1956.     jmp    IND(ATEMP1)        /* jump to procedure (with 2 args) */
  1957.  
  1958. CONSTS(0)
  1959. END
  1960.  
  1961. /*---------------------------------------------------------------------------*/
  1962.  
  1963. #undef LBL
  1964. #define LBL(x)MAKE_LBL(27,x)
  1965.  
  1966. BEGIN("###_kernel.wrong-nb-arg")
  1967.  
  1968. /* make room for 'procedure' argument */
  1969.  
  1970.     movw    DTEMP1,PVM1_REG
  1971.     movl    SP,ATEMP2
  1972.     subql    IMM(4),SP
  1973.     BRAS(    loop_entry)
  1974. LBL(loop):
  1975.     movl    PINC(ATEMP2),DISP(ATEMP2,-8)
  1976. LBL(loop_entry):
  1977.     DBRA(    PVM1_REG,loop)
  1978.  
  1979.     movl    ATEMP1,DISP(ATEMP2,-4)    /* put 'procedure' argument */
  1980.     addqw    IMM(1),DTEMP1
  1981.  
  1982.     movl    CONST(0),ATEMP1    /* apply ##exception.wrong-nb-arg */
  1983.     movl    CONST(1),ATEMP2
  1984.     jmp    IND(ATEMP2)
  1985.  
  1986. CONSTS(2)
  1987. PRIMITIVE("##exception.wrong-nb-arg")
  1988. PRIMITIVE("###_kernel.apply")
  1989. END
  1990.  
  1991. /*---------------------------------------------------------------------------*/
  1992.  
  1993. #undef LBL
  1994. #define LBL(x)MAKE_LBL(28,x)
  1995.  
  1996. BEGIN("###_kernel.switch-task")
  1997.  
  1998.     CMPL(    DISP(PSTATE_REG,SLOT(LTQ_HEAD)),LTQ_TAIL_REG)
  1999.     BNES(    there_are_other_tasks)
  2000.  
  2001.     CMPL(    DISP(PSTATE_REG,SLOT(WORKQ_TAIL)),NULL_REG)
  2002.     BNES(    there_are_other_tasks)
  2003.  
  2004.     movl    FALSE_REG,PVM1_REG    /* no other tasks to switch to */
  2005.     jmp    IND(PVM0_REG)
  2006.  
  2007. LBL(there_are_other_tasks):
  2008.  
  2009.     LOG(EVENT_TASK_SWITCH,log1)
  2010.  
  2011.     movl    PVM0_REG,PDEC(SP)
  2012.  
  2013. /* Call ###_kernel.transfer-lazy-tasks-to-heap. */
  2014.  
  2015.     pea    PC_IND(ret1)
  2016.     movl    CONST(0),ATEMP1
  2017.     jmp    IND(ATEMP1)
  2018. RETURN(ret1,1,1):
  2019.  
  2020. /* Call ###_kernel.transfer-stack-to-heap. */
  2021.  
  2022. /* ###_kernel.transfer-lazy-tasks-to-heap has reserved enough */
  2023. /* space, so no GC check required.                            */
  2024.  
  2025.     pea    PC_IND(ret2)
  2026.     movl    CONST(1),ATEMP1
  2027.     jmp    IND(ATEMP1)
  2028. LBL(ret2):
  2029.  
  2030. /* Save state of current task. */
  2031.  
  2032.     movl    DISP(PSTATE_REG,SLOT(CURRENT_TASK)),ATEMP1
  2033.  
  2034.     movl    PINC(SP),PVM0_REG
  2035.     movl    PVM0_REG,DISP(ATEMP1,SLOT(TASK_CONT_RET)+4-SCM_type_SUBTYPED)
  2036.     movl    PVM2_REG,DISP(ATEMP1,SLOT(TASK_CONT_FRAME)+4-SCM_type_SUBTYPED)
  2037.     movl    DISP(PSTATE_REG,SLOT(CURRENT_DYN_ENV)),DISP(ATEMP1,SLOT(TASK_CONT_DYN_ENV)+4-SCM_type_SUBTYPED)
  2038.     movl    IMM(SCM_true),DISP(ATEMP1,SLOT(TASK_VALUE)+4-SCM_type_SUBTYPED)
  2039.  
  2040. /* Add task to workq. */
  2041.  
  2042.     movl    ATEMP1,PDEC(HEAP_REG)
  2043.  
  2044. #ifdef MAINTAIN_TASK_STATUS
  2045.  
  2046. /* Change task's status to READY */
  2047.  
  2048.     movl    HEAP_REG,DISP(ATEMP1,SLOT(TASK_STATUS)+4-SCM_type_SUBTYPED)
  2049.  
  2050. #endif
  2051.  
  2052.     movl    FALSE_REG,DISP(PSTATE_REG,SLOT(WORKQ_LOCKO))
  2053. LBL(lock_workq):
  2054.     tstl    DISP(PSTATE_REG,SLOT(WORKQ_LOCKV))
  2055.     BNES(    lock_workq)
  2056.  
  2057.     movl    DISP(PSTATE_REG,SLOT(WORKQ_TAIL)),ATEMP1
  2058.     CMPL(    ATEMP1,NULL_REG)
  2059.     BNES(    non_empty_queue)
  2060.     movl    HEAP_REG,DISP(PSTATE_REG,SLOT(WORKQ_HEAD))
  2061.     BRAS(    fix_tail)
  2062. LBL(non_empty_queue):
  2063.     movl    HEAP_REG,PDEC(ATEMP1)
  2064.  
  2065. LBL(fix_tail):
  2066.     movl    HEAP_REG,DISP(PSTATE_REG,SLOT(WORKQ_TAIL))
  2067.  
  2068.     movl    NULL_REG,PDEC(HEAP_REG)
  2069.  
  2070.     clrl    DISP(PSTATE_REG,SLOT(WORKQ_LOCKO))
  2071.  
  2072. /* Go idle. */
  2073.  
  2074.     moveq    IMM(0),PVM1_REG
  2075.     movl    CONST(2),ATEMP1
  2076.     jmp    IND(ATEMP1)
  2077.  
  2078. CONSTS(3)
  2079. PRIMITIVE("###_kernel.transfer-lazy-tasks-to-heap")
  2080. PRIMITIVE("###_kernel.transfer-stack-to-heap")
  2081. PRIMITIVE("###_kernel.idle")
  2082. END
  2083.  
  2084. /*---------------------------------------------------------------------------*/
  2085.  
  2086. #undef LBL
  2087. #define LBL(x)MAKE_LBL(29,x)
  2088.  
  2089. BEGIN("###_kernel.idle")
  2090.  
  2091. #ifdef MAINTAIN_TASK_STATUS
  2092.  
  2093.     BEQS(    find_work)
  2094.  
  2095.     movl    PVM1_REG,ATEMP1
  2096.  
  2097. /* Check if task is really READY */
  2098.  
  2099.     lea    DISP(ATEMP1,SLOT(TASK_LOCKV)+4-SCM_type_SUBTYPED),ATEMP1
  2100. LBL(lock_task1):
  2101.     LOCK_ATEMP1(lock1)
  2102.     tstl    DISP(ATEMP1,SLOT(TASK_LOCKO-TASK_LOCKV))
  2103.     BEQS(    task_locked1)
  2104.     clrl    IND(ATEMP1)
  2105.     BRAS(    lock_task1)
  2106.  
  2107. LBL(task_locked1):
  2108.     movl    DISP(ATEMP1,SLOT(TASK_STATUS-TASK_LOCKV)),DTEMP1
  2109.     btst    DTEMP1,PAIR_REG
  2110.     BNES(    task_not_ready1)
  2111.  
  2112.     movl    DTEMP1,ATEMP2        /* remove task from workq */
  2113.     movl    FALSE_REG,IND(ATEMP2)
  2114.  
  2115. /* Change task's status to RUNNING */
  2116.  
  2117.     movl    PSTATE_REG,DISP(ATEMP1,SLOT(TASK_STATUS-TASK_LOCKV))
  2118.     clrl    IND(ATEMP1)
  2119.  
  2120.     lea    DISP(ATEMP1,-(SLOT(TASK_LOCKV)+4-SCM_type_SUBTYPED)),ATEMP1
  2121.  
  2122. #ifdef debug
  2123. /*****/    movl    IMM(1),DISP(PSTATE_REG,SLOT(58))
  2124. #endif
  2125.  
  2126.     BRAW(    resume_task)
  2127.  
  2128. LBL(task_not_ready1):
  2129.     clrl    IND(ATEMP1)
  2130.  
  2131. #endif
  2132.  
  2133. LBL(find_work):
  2134.  
  2135.     LOG(EVENT_IDLE,log1)
  2136.  
  2137. LBL(try_our_workq):
  2138.  
  2139. /* Try removing task from our own workq. */
  2140.  
  2141.     movl    FALSE_REG,DISP(PSTATE_REG,SLOT(WORKQ_LOCKO))
  2142. LBL(lock_workq1):
  2143.     tstl    DISP(PSTATE_REG,SLOT(WORKQ_LOCKV))
  2144.     BNES(    lock_workq1)
  2145.  
  2146.     movl    DISP(PSTATE_REG,SLOT(WORKQ_HEAD)),ATEMP1
  2147.     CMPL(    ATEMP1,NULL_REG)
  2148.     BEQS(    empty_queue1)
  2149.     movl    PDEC(ATEMP1),ATEMP2
  2150.     movl    ATEMP2,DISP(PSTATE_REG,SLOT(WORKQ_HEAD))
  2151.     CMPL(    ATEMP2,NULL_REG)
  2152.     BNES(    done1)
  2153.     movl    ATEMP2,DISP(PSTATE_REG,SLOT(WORKQ_TAIL))
  2154. LBL(done1):
  2155.  
  2156.     clrl    DISP(PSTATE_REG,SLOT(WORKQ_LOCKO))
  2157.  
  2158. /* Check if task is really READY */
  2159.  
  2160.     movl    DISP(ATEMP1,SLOT(1)),ATEMP1
  2161.  
  2162. #ifdef MAINTAIN_TASK_STATUS
  2163.  
  2164.     CMPL(    ATEMP1,FALSE_REG)
  2165.     BEQS(    try_our_workq)
  2166.  
  2167.     lea    DISP(ATEMP1,SLOT(TASK_LOCKV)+4-SCM_type_SUBTYPED),ATEMP1
  2168. LBL(lock_task2):
  2169.     LOCK_ATEMP1(lock2)
  2170.     tstl    DISP(ATEMP1,SLOT(TASK_LOCKO-TASK_LOCKV))
  2171.     BEQS(    task_locked2)
  2172.     clrl    IND(ATEMP1)
  2173.     BRAS(    lock_task2)
  2174.  
  2175. LBL(task_not_ready2):
  2176.     clrl    IND(ATEMP1)
  2177.     BRAS(    try_our_workq)
  2178.  
  2179. LBL(task_locked2):
  2180.     movl    DISP(ATEMP1,SLOT(TASK_STATUS-TASK_LOCKV)),DTEMP1
  2181.     btst    DTEMP1,PAIR_REG
  2182.     BNES(    task_not_ready2)
  2183.  
  2184.     movl    DTEMP1,ATEMP2        /* remove task from workq */
  2185.     movl    FALSE_REG,IND(ATEMP2)
  2186.  
  2187. /* Change task's status to RUNNING */
  2188.  
  2189.     movl    PSTATE_REG,DISP(ATEMP1,SLOT(TASK_STATUS-TASK_LOCKV))
  2190.     clrl    IND(ATEMP1)
  2191.  
  2192.     lea    DISP(ATEMP1,-(SLOT(TASK_LOCKV)+4-SCM_type_SUBTYPED)),ATEMP1
  2193.  
  2194. #endif
  2195.  
  2196. #ifdef debug
  2197. /*****/    movl    IMM(2),DISP(PSTATE_REG,SLOT(58))
  2198. #endif
  2199.  
  2200.     BRAW(    resume_task)
  2201.  
  2202. LBL(empty_queue1):
  2203.     clrl    DISP(PSTATE_REG,SLOT(WORKQ_LOCKO))
  2204.  
  2205. LBL(our_workq_empty):
  2206.  
  2207.     movl    FALSE_REG,DISP(PSTATE_REG,SLOT(CURRENT_TASK))
  2208.     movl    FALSE_REG,DISP(PSTATE_REG,SLOT(PARENT_RET))
  2209.     movl    FALSE_REG,DISP(PSTATE_REG,SLOT(PARENT_FRAME))
  2210.     movl    FALSE_REG,DISP(PSTATE_REG,SLOT(CURRENT_DYN_ENV))
  2211.  
  2212.     moveq    IMM(INTR_LATENCY_AFTER_STEAL-1),INTR_TIMER_REG
  2213.  
  2214. #ifdef debug
  2215. /*****/    pea    PC_IND($entry)
  2216. /*****/    movl    PINC(SP),DISP(PSTATE_REG,SLOT(56))
  2217. /*****/    movl    IMM(0),DISP(PSTATE_REG,SLOT(57))
  2218. /*****/    movl    IMM(0),DISP(PSTATE_REG,SLOT(58))
  2219. #endif
  2220.  
  2221. /*vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv*/
  2222. #ifdef MESSAGE_PASSING_STEAL
  2223.  
  2224. /* Prevent other processors from trying to steal from us. */
  2225.  
  2226.     movl    LTQ_TAIL_REG,DISP(PSTATE_REG,SLOT(LTQ_TAIL))
  2227.  
  2228. #ifdef SYNCHRONOUS_STEAL
  2229.  
  2230. LBL(wait_for_request):
  2231.     tstl    DISP(PSTATE_REG,SLOT(STEAL_LOCKV))
  2232.     BEQS(    no_steal)
  2233.     movl    DISP(PSTATE_REG,SLOT(THIEF)),DTEMP1
  2234.     BEQS(    wait_for_request)
  2235.     clrl    DISP(PSTATE_REG,SLOT(THIEF))
  2236.     clrl    DISP(PSTATE_REG,SLOT(STEAL_LOCKV))
  2237.     movl    DTEMP1,ATEMP1
  2238.     clrl    DISP(ATEMP1,SLOT(RESPONSE))
  2239. LBL(no_steal):
  2240.  
  2241. #endif
  2242. #endif
  2243. /*^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^*/
  2244.  
  2245. LBL(try_to_steal_from_other_workq):
  2246.     movl    DISP(PSTATE_REG,SLOT(STEAL_SCAN)),PVM2_REG
  2247.     lea    DISP(PSTATE_REG,SLOT(PS+MAX_NB_PROC)),ATEMP2
  2248.     addl    PVM2_REG,ATEMP2
  2249.  
  2250. LBL(next_processor):
  2251.     subql    IMM(4),PVM2_REG
  2252.     BLEW(    scan_done)
  2253.  
  2254. LBL(check_workq):
  2255.     subql    IMM(4),ATEMP2
  2256. LBL(check_same_workq):
  2257.     movl    IND(ATEMP2),ATEMP1
  2258.     CMPL(    DISP(ATEMP1,SLOT(WORKQ_HEAD)),NULL_REG)
  2259.     BEQW(    empty_queue3)
  2260.  
  2261.     lea    DISP(ATEMP1,SLOT(WORKQ_LOCKV)),ATEMP1
  2262. LBL(lock_workq2):
  2263.     LOCK_ATEMP1(lock3)
  2264.     tstl    DISP(ATEMP1,SLOT(WORKQ_LOCKO-WORKQ_LOCKV))
  2265.     BEQS(    workq_locked)
  2266.     clrl    IND(ATEMP1)
  2267.     BRAS(    lock_workq2)
  2268. LBL(workq_locked):
  2269.     movl    DISP(ATEMP1,SLOT(WORKQ_HEAD-WORKQ_LOCKV)),PVM0_REG
  2270.     CMPL(    PVM0_REG,NULL_REG)
  2271.     BEQW(    empty_queue2)
  2272.     movl    PDEC(PVM0_REG),DTEMP1
  2273.     movl    DTEMP1,DISP(ATEMP1,SLOT(WORKQ_HEAD-WORKQ_LOCKV))
  2274.     CMPL(    DTEMP1,NULL_REG)
  2275.     BNES(    done2)
  2276.     movl    DTEMP1,DISP(ATEMP1,SLOT(WORKQ_TAIL-WORKQ_LOCKV))
  2277. LBL(done2):
  2278.  
  2279.     clrl    IND(ATEMP1)
  2280.  
  2281. /* Check if task is really READY */
  2282.  
  2283.     movl    DISP(PVM0_REG,SLOT(1)),ATEMP1
  2284.  
  2285. #ifdef MAINTAIN_TASK_STATUS
  2286.  
  2287.     CMPL(    ATEMP1,FALSE_REG)
  2288.     BEQS(    check_same_workq)
  2289.  
  2290.     lea    DISP(ATEMP1,SLOT(TASK_LOCKV)+4-SCM_type_SUBTYPED),ATEMP1
  2291. LBL(lock_task3):
  2292.     LOCK_ATEMP1(lock4)
  2293.     tstl    DISP(ATEMP1,SLOT(TASK_LOCKO-TASK_LOCKV))
  2294.     BEQS(    task_locked3)
  2295.     clrl    IND(ATEMP1)
  2296.     BRAS(    lock_task3)
  2297.  
  2298. LBL(task_not_ready3):
  2299.     clrl    IND(ATEMP1)
  2300.     BRAS(    check_same_workq)
  2301.  
  2302. LBL(task_locked3):
  2303.     movl    DISP(ATEMP1,SLOT(TASK_STATUS-TASK_LOCKV)),DTEMP1
  2304.     btst    DTEMP1,PAIR_REG
  2305.     BNES(    task_not_ready3)
  2306.  
  2307.     movl    DTEMP1,ATEMP2        /* remove task from workq */
  2308.     movl    FALSE_REG,IND(ATEMP2)
  2309.  
  2310. /* Change task's status to RUNNING */
  2311.  
  2312.     movl    PSTATE_REG,DISP(ATEMP1,SLOT(TASK_STATUS-TASK_LOCKV))
  2313.     clrl    IND(ATEMP1)
  2314.  
  2315.     lea    DISP(ATEMP1,-(SLOT(TASK_LOCKV)+4-SCM_type_SUBTYPED)),ATEMP1
  2316.  
  2317. #endif
  2318.  
  2319.     movl    PVM2_REG,DISP(PSTATE_REG,SLOT(STEAL_SCAN))
  2320.  
  2321. #ifdef debug
  2322. /*****/    movl    IMM(3),DISP(PSTATE_REG,SLOT(58))
  2323. #endif
  2324.  
  2325. LBL(resume_task):
  2326.  
  2327. /* Resume task. */
  2328.  
  2329.     movl    ATEMP1,DISP(PSTATE_REG,SLOT(CURRENT_TASK))
  2330.     movl    DISP(ATEMP1,SLOT(TASK_CONT_RET)+4-SCM_type_SUBTYPED),DISP(PSTATE_REG,SLOT(PARENT_RET))
  2331.     movl    DISP(ATEMP1,SLOT(TASK_CONT_FRAME)+4-SCM_type_SUBTYPED),DISP(PSTATE_REG,SLOT(PARENT_FRAME))
  2332.     movl    DISP(ATEMP1,SLOT(TASK_CONT_DYN_ENV)+4-SCM_type_SUBTYPED),DISP(PSTATE_REG,SLOT(CURRENT_DYN_ENV))
  2333.     movl    DISP(ATEMP1,SLOT(TASK_VALUE)+4-SCM_type_SUBTYPED),PVM1_REG
  2334.  
  2335. #ifdef debug
  2336. /*****/    pea    PC_IND($entry)
  2337. /*****/    movl    PINC(SP),DISP(PSTATE_REG,SLOT(56))
  2338. /*****/    movl    DISP(PSTATE_REG,SLOT(BOS_RET)),DISP(PSTATE_REG,SLOT(57))
  2339. #endif
  2340.  
  2341.     movl    PVM1_REG,PVM0_REG
  2342.     movl    PVM1_REG,PVM2_REG
  2343.     movl    PVM1_REG,PVM3_REG
  2344.     movl    PVM1_REG,PVM4_REG
  2345.  
  2346.     LOG(EVENT_WORKING,log2)
  2347.  
  2348.     movl    DISP(PSTATE_REG,SLOT(BOS_RET)),ATEMP1
  2349.     jmp    IND(ATEMP1)
  2350.  
  2351. LBL(empty_queue2):
  2352.     clrl    IND(ATEMP1)
  2353.     lea    DISP(ATEMP1,-SLOT(WORKQ_LOCKV)),ATEMP1
  2354. LBL(empty_queue3):
  2355.  
  2356. /*vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv*/
  2357. #ifdef MESSAGE_PASSING_STEAL
  2358.  
  2359. /* Check if anything to steal. */
  2360.  
  2361.     movl    DISP(ATEMP1,SLOT(LTQ_HEAD)),DTEMP1
  2362.     CMPL(    DISP(ATEMP1,SLOT(LTQ_TAIL)),DTEMP1)
  2363.     BEQW(    next_processor)
  2364.  
  2365. #ifdef SYNCHRONOUS_STEAL
  2366.  
  2367.     movl    ATEMP1,PVM4_REG
  2368.  
  2369. /* Try to become thief. */
  2370.  
  2371.     movl    ATEMP1,DTEMP1
  2372.     addl    IMM(SLOT(STEAL_LOCKV)),DTEMP1
  2373.     READ_AND_SET_DTEMP1
  2374.     tstl    DTEMP1
  2375.     BNEW(    next_processor)
  2376.  
  2377.     movl    PVM4_REG,ATEMP1
  2378.     movl    DISP(ATEMP1,SLOT(LTQ_HEAD)),DTEMP1
  2379.     CMPL(    DISP(ATEMP1,SLOT(LTQ_TAIL)),DTEMP1)
  2380.     BNES(    we_are_thief)
  2381.  
  2382.     clrl    DISP(ATEMP1,SLOT(STEAL_LOCKV))
  2383.     BRAW(    next_processor)
  2384.  
  2385. LBL(we_are_thief):
  2386.  
  2387. /* Send steal message to victim. */
  2388.  
  2389.     movl    FALSE_REG,DISP(PSTATE_REG,SLOT(RESPONSE))
  2390.     movl    PSTATE_REG,DISP(ATEMP1,SLOT(THIEF))
  2391.     movl    IMM(-1),IND(ATEMP1)
  2392.  
  2393.     LOG(EVENT_STEALING,log3)
  2394.  
  2395. /* Wait for response. */
  2396.  
  2397.     movl    PVM2_REG,DISP(PSTATE_REG,SLOT(STEAL_SCAN))
  2398.  
  2399. LBL(wait):
  2400.     tstl    DISP(PSTATE_REG,SLOT(INTR_BARRIER))
  2401.     BEQS(    ret3)
  2402.     clrl    DISP(PSTATE_REG,SLOT(INTR_BARRIER))
  2403.     lea    PC_IND(ret3),PVM0_REG
  2404.     movl    PVM0_REG,PVM1_REG
  2405.     movl    PVM0_REG,PVM2_REG
  2406.     movl    PVM0_REG,PVM3_REG
  2407.     movl    PVM0_REG,PVM4_REG
  2408.     movl    CONST(0),ATEMP1    /* Call ##barrier */
  2409.     moveq    IMM(1),DTEMP1
  2410.     jmp    IND(ATEMP1)
  2411. RETURN(ret3,0,0):
  2412.     movl    DISP(PSTATE_REG,SLOT(RESPONSE)),ATEMP1
  2413.     CMPL(    ATEMP1,FALSE_REG)
  2414.     BEQS(    wait)
  2415.  
  2416.     clrl    DISP(PSTATE_REG,SLOT(RESPONSE))
  2417.  
  2418. #ifdef debug
  2419. /*****/    movl    ATEMP1,DISP(PSTATE_REG,SLOT(58))
  2420. #endif
  2421.  
  2422.     movl    ATEMP1,DTEMP1
  2423.     BNEW(    resume_task)
  2424.  
  2425.     LOG(EVENT_IDLE,log4)
  2426.  
  2427.     BRAW(    try_to_steal_from_other_workq)
  2428.  
  2429. #else
  2430. /* ASYNCHRONOUS_STEAL */
  2431.  
  2432.     movl    FALSE_REG,DISP(ATEMP1,SLOT(WORK_REQUEST))
  2433.     movl    IMM(-1),IND(ATEMP1)
  2434.     BRAW(    next_processor)
  2435.  
  2436. #endif
  2437.  
  2438. /*---------------------------------------------------------------------------*/
  2439. #else
  2440. /* SHARED_MEMORY_STEAL */
  2441.  
  2442. /* acquire steal_lock */
  2443.  
  2444.     movl    DISP(ATEMP1,SLOT(STEAL_LOCKO)),DTEMP1
  2445.     BNEW(    next_processor)
  2446.  
  2447.     movl    ATEMP1,PVM4_REG
  2448.  
  2449. /* Try to become thief. */
  2450.  
  2451.     movl    ATEMP1,DTEMP1
  2452.     addl    IMM(SLOT(STEAL_LOCKV)),DTEMP1
  2453.     READ_AND_SET_DTEMP1
  2454.     tstl    DTEMP1
  2455.     BNEW(    next_processor)
  2456.  
  2457.     movl    PVM4_REG,ATEMP1
  2458.  
  2459.     movl    DISP(ATEMP1,SLOT(STEAL_LOCKO)),DTEMP1
  2460.     BNES(    fail)
  2461.  
  2462.     movl    DISP(ATEMP1,SLOT(LTQ_HEAD)),PVM0_REG
  2463.     addql    IMM(4),PVM0_REG
  2464.     movl    PVM0_REG,DISP(ATEMP1,SLOT(LTQ_HEAD))
  2465.     movl    DISP(PVM0_REG,-SLOT(1)),DTEMP1
  2466.     BNES(    we_are_thief)
  2467.     subql    IMM(4),PVM0_REG
  2468.     movl    PVM0_REG,DISP(ATEMP1,SLOT(LTQ_HEAD))
  2469.  
  2470. LBL(fail):
  2471.     clrl    DISP(ATEMP1,SLOT(STEAL_LOCKV))
  2472.     BRAW(    next_processor)
  2473.  
  2474. LBL(we_are_thief):
  2475.  
  2476.     movl    PVM2_REG,DISP(PSTATE_REG,SLOT(STEAL_SCAN))
  2477.  
  2478. /* setup parent task */
  2479.  
  2480.     movl    DISP(PSTATE_REG,SLOT(TEMP_TASK)),PVM2_REG
  2481.     movl    PVM2_REG,DISP(PSTATE_REG,SLOT(CURRENT_TASK))
  2482.     movl    PVM2_REG,ATEMP2
  2483.     movl    DISP(ATEMP2,SLOT(TASK_SYNC_PH)+4-SCM_type_SUBTYPED),PVM1_REG
  2484.  
  2485. #ifdef MAINTAIN_TASK_STATUS
  2486.  
  2487. /* Link placeholder to current task so that it can get resumed when the */
  2488. /* placeholder is touched (and the task is READY). */
  2489.  
  2490.     movl    PVM1_REG,ATEMP2
  2491.     movl    DISP(ATEMP1,SLOT(CURRENT_TASK)),DISP(ATEMP2,SLOT(PH_TASK)-SCM_type_PLACEHOLDER)
  2492.  
  2493.     movl    PVM2_REG,ATEMP2
  2494.     movl    PSTATE_REG,DISP(ATEMP2,SLOT(TASK_STATUS)+4-SCM_type_SUBTYPED)
  2495.  
  2496. #endif
  2497.  
  2498. /* DTEMP1 = lazy task frame pointer */
  2499.  
  2500.     movl    DTEMP1,ATEMP2        /* get task's return address */
  2501.     movl    IND(ATEMP2),PVM3_REG
  2502.  
  2503.     movl    DISP(ATEMP1,SLOT(PARENT_RET)),DISP(PSTATE_REG,SLOT(PARENT_RET))
  2504.     movl    DISP(ATEMP1,SLOT(PARENT_FRAME)),DISP(PSTATE_REG,SLOT(PARENT_FRAME))
  2505.     movl    DISP(ATEMP1,SLOT(CURRENT_DYN_ENV)),DISP(PSTATE_REG,SLOT(CURRENT_DYN_ENV))
  2506.  
  2507.     movl    PVM3_REG,DISP(ATEMP1,SLOT(PARENT_RET))
  2508.     subql    IMM(8),PVM3_REG        /* convert return adr to normal one */
  2509.  
  2510. /* Make child's continuation frame. */
  2511.  
  2512.     movl    PVM3_REG,PDEC(HEAP_REG)
  2513.     movl    PVM2_REG,PDEC(HEAP_REG)
  2514. /* katz/weise continuations would require stolen stack frame to be put on heap
  2515.     movl    DISP(ATEMP1,SLOT(PARENT_FRAME)),PDEC(HEAP_REG)
  2516. */
  2517.     movl    FALSE_REG,PDEC(HEAP_REG)
  2518.     movl    IMM(3*0x400+(SCM_subtype_FRAME*8)),PDEC(HEAP_REG)
  2519.     lea    DISP(HEAP_REG,SCM_type_SUBTYPED),ATEMP2
  2520.  
  2521.     movl    ATEMP2,DISP(ATEMP1,SLOT(PARENT_FRAME))
  2522.  
  2523. /* copy victim's stack */
  2524.  
  2525.     movl    DISP(PVM0_REG,-SLOT(2)),PVM0_REG /* get base of continuation */
  2526.  
  2527.     movl    DTEMP1,ATEMP2
  2528.     movl    PVM0_REG,DTEMP1
  2529.     subl    ATEMP2,DTEMP1    /* DTEMP1 = length of stack area to copy */
  2530.  
  2531.     subl    DTEMP1,SP
  2532.     movl    SP,PVM0_REG
  2533.  
  2534.     lsrl    IMM(2),DTEMP1
  2535.     subql    IMM(1),DTEMP1
  2536. LBL(loop):
  2537.     movl    PINC(ATEMP2),PINC(PVM0_REG)
  2538.     DBRA(    DTEMP1,loop)
  2539.  
  2540. /* unlock steal_lock */
  2541.  
  2542.     clrl    DISP(ATEMP1,SLOT(STEAL_LOCKV))
  2543.  
  2544.     addql    IMM(8),DISP(PSTATE_REG,SLOT(COUNT1))
  2545.  
  2546.     MAKE_TEMP_TASK
  2547.  
  2548. #ifdef debug
  2549. /*****/    pea    PC_IND($entry)
  2550. /*****/    movl    PINC(SP),DISP(PSTATE_REG,SLOT(56))
  2551. /*****/    movl    PVM3_REG,DISP(PSTATE_REG,SLOT(57))
  2552. /*****/    movl    IMM(0),DISP(PSTATE_REG,SLOT(58))
  2553. #endif
  2554.  
  2555.     movl    PVM3_REG,ATEMP2
  2556.  
  2557. /* Resume task. */
  2558.  
  2559.     movl    PVM1_REG,PVM0_REG
  2560.     movl    PVM1_REG,PVM2_REG
  2561.     movl    PVM1_REG,PVM3_REG
  2562.     movl    PVM1_REG,PVM4_REG
  2563.  
  2564.     LOG(EVENT_WORKING,log5)
  2565.  
  2566.     jmp    IND(ATEMP2)
  2567.  
  2568. #endif
  2569. /*^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^*/
  2570.  
  2571. LBL(scan_done):
  2572.     movl    DISP(PSTATE_REG,SLOT(NB_PROCESSORS)),PVM2_REG
  2573.     asrl    IMM(1),PVM2_REG
  2574.     movl    PVM2_REG,DISP(PSTATE_REG,SLOT(STEAL_SCAN))
  2575.  
  2576.     tstl    DISP(PSTATE_REG,SLOT(INTR_BARRIER))
  2577.     BEQS(    ret4)
  2578.     clrl    DISP(PSTATE_REG,SLOT(INTR_BARRIER))
  2579.     lea    PC_IND(ret4),PVM0_REG
  2580.     movl    PVM0_REG,PVM1_REG
  2581.     movl    PVM0_REG,PVM2_REG
  2582.     movl    PVM0_REG,PVM3_REG
  2583.     movl    PVM0_REG,PVM4_REG
  2584.     movl    CONST(0),ATEMP1    /* Call ##barrier */
  2585.     moveq    IMM(1),DTEMP1
  2586.     jmp    IND(ATEMP1)
  2587. RETURN(ret4,0,0):
  2588.  
  2589.     BRAW(    try_to_steal_from_other_workq)
  2590.  
  2591. CONSTS(1)
  2592. PRIMITIVE("##barrier")
  2593. END
  2594.  
  2595. /*---------------------------------------------------------------------------*/
  2596.  
  2597. #undef LBL
  2598. #define LBL(x)MAKE_LBL(30,x)
  2599.  
  2600. BEGIN("###_kernel.determine!")
  2601.  
  2602. #ifdef DETERMINE_IS_STRICT
  2603.     btst    PVM2_REG,PLACEHOLDER_REG
  2604.     BNES(    touched)
  2605.     movl    PVM0_REG,PDEC(SP)
  2606.     movl    PVM1_REG,PDEC(SP)
  2607.     TRAP(TOUCH_trap+2,touch,2,1)
  2608.     movl    PINC(SP),PVM1_REG
  2609.     movl    PINC(SP),PVM0_REG
  2610. LBL(touched):
  2611. #endif
  2612.  
  2613.     movl    CONST(0),ATEMP1
  2614.     jmp    IND(ATEMP1)
  2615.     
  2616. CONSTS(1)
  2617. PRIMITIVE("###_kernel.non-strict-determine!")
  2618. END
  2619.  
  2620. /*---------------------------------------------------------------------------*/
  2621.  
  2622. #undef LBL
  2623. #define LBL(x)MAKE_LBL(31,x)
  2624.  
  2625. BEGIN("###_kernel.non-strict-determine!")
  2626.  
  2627.     movl    PVM0_REG,PDEC(SP)
  2628.  
  2629.     LOG(EVENT_DETERMINE,log1)
  2630.  
  2631.     btst    PVM1_REG,PLACEHOLDER_REG
  2632.     BNES(    already_determined)
  2633.  
  2634.     movl    PVM1_REG,ATEMP2
  2635.     lea    DISP(ATEMP2,SLOT(PH_QUEUE)-SCM_type_PLACEHOLDER),ATEMP2
  2636.  
  2637.     LOCK_ATEMP2(lock1)
  2638.  
  2639.     CMPL(    DTEMP1,FALSE_REG)
  2640.     BNES(    undetermined)
  2641.     movl    DTEMP1,IND(ATEMP2)
  2642.  
  2643. LBL(already_determined):
  2644.     PREV_LOG(2,log2)
  2645.     movl    PINC(SP),PVM0_REG
  2646.     movl    CONST(0),ATEMP1    /* jump to ##exception.placeholder-already-determined */
  2647.     moveq    IMM(1),DTEMP1    /* passing 0 argument */
  2648.     jmp    IND(ATEMP1)
  2649.  
  2650. LBL(undetermined):
  2651.     movl    PVM2_REG,DISP(ATEMP2,SLOT(PH_VALUE-PH_QUEUE))
  2652.  
  2653.     movl    FALSE_REG,IND(ATEMP2)
  2654.  
  2655. /* DTEMP1 is list of tasks to restart. */
  2656.  
  2657.     btst    DTEMP1,PAIR_REG
  2658.     BNES(    tasks_restarted)
  2659.  
  2660.     movl    DTEMP1,PVM4_REG
  2661. LBL(next_task):
  2662.     movl    DTEMP1,ATEMP2
  2663.  
  2664. /* Setup task's return value. */
  2665.  
  2666.     movl    IND(ATEMP2),ATEMP1
  2667.     movl    PVM2_REG,DISP(ATEMP1,SLOT(TASK_VALUE)+4-SCM_type_SUBTYPED)
  2668.  
  2669. #ifdef MAINTAIN_TASK_STATUS
  2670.  
  2671. /* Change task's status to READY */
  2672.  
  2673.     movl    ATEMP2,DISP(ATEMP1,SLOT(TASK_STATUS)+4-SCM_type_SUBTYPED)
  2674.  
  2675. #endif
  2676.  
  2677.     movl    DISP(ATEMP2,SLOT(-1)),DTEMP1
  2678.     btst    DTEMP1,PAIR_REG
  2679.     BEQS(    next_task)
  2680.  
  2681. /* Add tasks to workq. */
  2682.  
  2683.     movl    FALSE_REG,DISP(PSTATE_REG,SLOT(WORKQ_LOCKO))
  2684. LBL(lock_workq):
  2685.     tstl    DISP(PSTATE_REG,SLOT(WORKQ_LOCKV))
  2686.     BNES(    lock_workq)
  2687.  
  2688.     movl    DISP(PSTATE_REG,SLOT(WORKQ_TAIL)),ATEMP1
  2689.     CMPL(    ATEMP1,NULL_REG)
  2690.     BNES(    non_empty_queue)
  2691.     movl    PVM4_REG,DISP(PSTATE_REG,SLOT(WORKQ_HEAD))
  2692.     BRAS(    fix_tail)
  2693. LBL(non_empty_queue):
  2694.     movl    PVM4_REG,PDEC(ATEMP1)
  2695. LBL(fix_tail):
  2696.     movl    ATEMP2,DISP(PSTATE_REG,SLOT(WORKQ_TAIL))
  2697.  
  2698.     clrl    DISP(PSTATE_REG,SLOT(WORKQ_LOCKO))
  2699.  
  2700. LBL(tasks_restarted):
  2701.     movl    PVM2_REG,PVM1_REG
  2702.     movl    PVM2_REG,PVM3_REG
  2703.     movl    PVM2_REG,PVM4_REG
  2704.     movl    PINC(SP),PVM0_REG
  2705.  
  2706.     PREV_LOG(2,log3)
  2707.  
  2708.     movl    PVM2_REG,DTEMP1 /* Required for the case of a return from a touch of d0 */
  2709.     jmp    IND(PVM0_REG)    
  2710.  
  2711. CONSTS(1)
  2712. PRIMITIVE("##exception.placeholder-already-determined")
  2713. END
  2714.  
  2715. /*---------------------------------------------------------------------------*/
  2716.  
  2717. #undef LBL
  2718. #define LBL(x)MAKE_LBL(32,x)
  2719.  
  2720. BEGIN("###_kernel.determine!-then-idle")
  2721.  
  2722.     movl    PVM0_REG,PDEC(SP)
  2723.  
  2724. #ifdef DETERMINE_IS_STRICT
  2725.     btst    PVM2_REG,PLACEHOLDER_REG
  2726.     BNES(    touched)
  2727.     movl    PVM1_REG,PDEC(SP)
  2728.     movl    PVM3_REG,PDEC(SP)
  2729.     TRAP(TOUCH_trap+2,touch,3,1)
  2730.     movl    PINC(SP),PVM3_REG
  2731.     movl    PINC(SP),PVM1_REG
  2732. LBL(touched):
  2733. #endif
  2734.  
  2735.     LOG(EVENT_DETERMINE,log1)
  2736.  
  2737.     btst    PVM1_REG,PLACEHOLDER_REG
  2738.     BNES(    already_determined)
  2739.  
  2740.     movl    PVM1_REG,ATEMP2
  2741.     lea    DISP(ATEMP2,SLOT(PH_QUEUE)-SCM_type_PLACEHOLDER),ATEMP2
  2742.  
  2743.     LOCK_ATEMP2(lock1)
  2744.  
  2745.     CMPL(    DTEMP1,FALSE_REG)
  2746.     BNES(    undetermined)
  2747.     movl    DTEMP1,IND(ATEMP2)
  2748.  
  2749. LBL(already_determined):
  2750.     PREV_LOG(2,log2)
  2751.     movl    PINC(SP),PVM0_REG
  2752.     movl    CONST(1),ATEMP1    /* jump to ##exception.placeholder-already-determined */
  2753.     moveq    IMM(1),DTEMP1    /* passing 0 argument */
  2754.     jmp    IND(ATEMP1)
  2755.  
  2756. LBL(no_task_to_restart):
  2757.     movl    PVM3_REG,PVM1_REG
  2758.     movl    CONST(0),ATEMP1
  2759.     jmp    IND(ATEMP1)
  2760.  
  2761. LBL(undetermined):
  2762.     movl    PINC(SP),PVM0_REG
  2763.  
  2764.     movl    PVM2_REG,DISP(ATEMP2,SLOT(PH_VALUE-PH_QUEUE))
  2765.  
  2766.     movl    FALSE_REG,IND(ATEMP2)
  2767.  
  2768. #ifdef MAINTAIN_TASK_STATUS
  2769.  
  2770. /* Change task's status to DEAD */
  2771.  
  2772.     movl    DISP(PSTATE_REG,SLOT(CURRENT_TASK)),ATEMP1
  2773.     movl    FALSE_REG,DISP(ATEMP1,SLOT(TASK_STATUS)+4-SCM_type_SUBTYPED)
  2774.  
  2775. #endif
  2776.  
  2777. /* DTEMP1 is list of tasks to restart. */
  2778.  
  2779.     btst    DTEMP1,PAIR_REG
  2780.     BNES(    no_task_to_restart)
  2781.  
  2782.     movl    DTEMP1,ATEMP2
  2783.     movl    IND(ATEMP2),PVM3_REG
  2784.     movl    PDEC(ATEMP2),DTEMP1
  2785.     btst    DTEMP1,PAIR_REG
  2786.     BNES(    tasks_restarted)
  2787.  
  2788.     movl    DTEMP1,PVM4_REG
  2789. LBL(next_task):
  2790.     movl    DTEMP1,ATEMP2
  2791.  
  2792. /* Setup task's return value. */
  2793.  
  2794.     movl    IND(ATEMP2),ATEMP1
  2795.     movl    PVM2_REG,DISP(ATEMP1,SLOT(TASK_VALUE)+4-SCM_type_SUBTYPED)
  2796.  
  2797. #ifdef MAINTAIN_TASK_STATUS
  2798.  
  2799. /* Change task's status to READY */
  2800.  
  2801.     movl    ATEMP2,DISP(ATEMP1,SLOT(TASK_STATUS)+4-SCM_type_SUBTYPED)
  2802.  
  2803. #endif
  2804.  
  2805.     movl    DISP(ATEMP2,SLOT(-1)),DTEMP1
  2806.     btst    DTEMP1,PAIR_REG
  2807.     BEQS(    next_task)
  2808.  
  2809. /* Add tasks to workq. */
  2810.  
  2811.     movl    FALSE_REG,DISP(PSTATE_REG,SLOT(WORKQ_LOCKO))
  2812. LBL(lock_workq):
  2813.     tstl    DISP(PSTATE_REG,SLOT(WORKQ_LOCKV))
  2814.     BNES(    lock_workq)
  2815.  
  2816.     movl    DISP(PSTATE_REG,SLOT(WORKQ_TAIL)),ATEMP1
  2817.     CMPL(    ATEMP1,NULL_REG)
  2818.     BNES(    non_empty_queue)
  2819.     movl    PVM4_REG,DISP(PSTATE_REG,SLOT(WORKQ_HEAD))
  2820.     BRAS(    fix_tail)
  2821. LBL(non_empty_queue):
  2822.     movl    PVM4_REG,PDEC(ATEMP1)
  2823. LBL(fix_tail):
  2824.     movl    ATEMP2,DISP(PSTATE_REG,SLOT(WORKQ_TAIL))
  2825.  
  2826.     clrl    DISP(PSTATE_REG,SLOT(WORKQ_LOCKO))
  2827.  
  2828. LBL(tasks_restarted):
  2829.  
  2830.     movl    PVM3_REG,ATEMP1
  2831.  
  2832. #ifdef MAINTAIN_TASK_STATUS
  2833.  
  2834. /* Change task's status to RUNNING */
  2835.  
  2836.     movl    PSTATE_REG,DISP(ATEMP1,SLOT(TASK_STATUS)+4-SCM_type_SUBTYPED)
  2837.  
  2838. #endif
  2839.  
  2840. /* Resume task. */
  2841.  
  2842.     movl    ATEMP1,DISP(PSTATE_REG,SLOT(CURRENT_TASK))
  2843.     movl    DISP(ATEMP1,SLOT(TASK_CONT_RET)+4-SCM_type_SUBTYPED),DISP(PSTATE_REG,SLOT(PARENT_RET))
  2844.     movl    DISP(ATEMP1,SLOT(TASK_CONT_FRAME)+4-SCM_type_SUBTYPED),DISP(PSTATE_REG,SLOT(PARENT_FRAME))
  2845.     movl    DISP(ATEMP1,SLOT(TASK_CONT_DYN_ENV)+4-SCM_type_SUBTYPED),DISP(PSTATE_REG,SLOT(CURRENT_DYN_ENV))
  2846.  
  2847. #ifdef debug
  2848. /*****/    pea    PC_IND($entry)
  2849. /*****/    movl    PINC(SP),DISP(PSTATE_REG,SLOT(56))
  2850. /*****/    movl    DISP(PSTATE_REG,SLOT(BOS_RET)),DISP(PSTATE_REG,SLOT(57))
  2851. /*****/    movl    IMM(0),DISP(PSTATE_REG,SLOT(58))
  2852. #endif
  2853.  
  2854.     movl    PVM2_REG,PVM1_REG
  2855.     movl    PVM1_REG,PVM0_REG
  2856.     movl    PVM1_REG,PVM3_REG
  2857.     movl    PVM1_REG,PVM4_REG
  2858.  
  2859.     LOG(EVENT_WORKING,log3)
  2860.  
  2861.     movl    DISP(PSTATE_REG,SLOT(BOS_RET)),ATEMP1
  2862.     jmp    IND(ATEMP1)
  2863.  
  2864. CONSTS(2)
  2865. PRIMITIVE("###_kernel.idle")
  2866. PRIMITIVE("##exception.placeholder-already-determined")
  2867. END
  2868.  
  2869. /*---------------------------------------------------------------------------*/
  2870.  
  2871. #undef LBL
  2872. #define LBL(x)MAKE_LBL(33,x)
  2873.  
  2874. BEGIN("###_kernel.touch")
  2875.  
  2876.     movl    PVM0_REG,PDEC(SP)
  2877.     movl    ATEMP2,PVM4_REG
  2878.  
  2879. /* Check if the placeholder was generated by a DELAY. */
  2880.  
  2881.     tstl    DISP(ATEMP2,SLOT(PH_DELAY)-SCM_type_PLACEHOLDER)
  2882.     BEQS(    not_delay_ph2)
  2883.  
  2884.     lea    DISP(ATEMP2,SLOT(PH_QUEUE)-SCM_type_PLACEHOLDER),ATEMP2
  2885.  
  2886.     LOCK_ATEMP2(lock1)
  2887.  
  2888.     movl    DISP(ATEMP2,SLOT(PH_DELAY)-SLOT(PH_QUEUE)),PVM1_REG
  2889.     BEQS(    not_delay_ph1)
  2890.  
  2891.     clrl    DISP(ATEMP2,SLOT(PH_DELAY)-SLOT(PH_QUEUE))
  2892.     movl    DTEMP1,IND(ATEMP2)
  2893.  
  2894.     movl    PVM4_REG,PDEC(SP)
  2895.  
  2896. /* Restore delayed computation. */
  2897.  
  2898.     subql    IMM(SCM_type_SUBTYPED),PVM1_REG
  2899.     movl    PVM1_REG,ATEMP1
  2900.  
  2901.     movl    PINC(ATEMP1),DTEMP1
  2902.     lsrl    IMM(8),DTEMP1
  2903.     subql    IMM(4),DTEMP1
  2904.     subl    DTEMP1,SP
  2905.     lsrl    IMM(2),DTEMP1
  2906.  
  2907.     movl    PINC(ATEMP1),PVM0_REG
  2908.     subql    IMM(1),DTEMP1
  2909.     movl    SP,ATEMP2
  2910. LBL(copy):
  2911.     movl    PINC(ATEMP1),PINC(ATEMP2)
  2912.     DBRA(    DTEMP1,copy)
  2913.  
  2914.     lea    PC_IND(ret1),ATEMP1
  2915.  
  2916.     moveq    IMM(0),PVM1_REG
  2917.     movw    DISP(PVM0_REG,-4),PVM1_REG    /* get link */
  2918.     movl    ATEMP1,INXW(SP,PVM1_REG,0)
  2919.  
  2920.     PREV_LOG(2,log1)
  2921.  
  2922.     movl    PVM2_REG,PVM1_REG
  2923.     jmp    IND(PVM0_REG)
  2924. RETURN(ret1,2,1):
  2925.  
  2926.     movl    PVM1_REG,PVM2_REG
  2927.     movl    PINC(SP),PVM1_REG
  2928.     movl    PINC(SP),PVM0_REG
  2929.  
  2930.     movl    CONST(3),ATEMP1    /* jump to ###_kernel.determine! */
  2931.     jmp    IND(ATEMP1)
  2932.  
  2933. LBL(not_delay_ph1):
  2934.     movl    DTEMP1,IND(ATEMP2)
  2935.  
  2936. LBL(not_delay_ph2):
  2937.  
  2938. /* Call ###_kernel.transfer-lazy-tasks-to-heap. */
  2939.  
  2940.     pea    PC_IND(ret2)
  2941.     movl    CONST(0),ATEMP1
  2942.     jmp    IND(ATEMP1)
  2943. RETURN(ret2,1,1):
  2944.  
  2945. /* Call ###_kernel.transfer-stack-to-heap. */
  2946.  
  2947. /* ###_kernel.transfer-lazy-tasks-to-heap has reserved enough */
  2948. /* space, so no GC check required.                            */
  2949.  
  2950.     pea    PC_IND(ret3)
  2951.     movl    CONST(1),ATEMP1
  2952.     jmp    IND(ATEMP1)
  2953. LBL(ret3):
  2954.  
  2955. /* Save state of current task. */
  2956.  
  2957.     movl    DISP(PSTATE_REG,SLOT(CURRENT_TASK)),ATEMP1
  2958.  
  2959.     movl    PINC(SP),PVM0_REG
  2960.     movl    PVM0_REG,DISP(ATEMP1,SLOT(TASK_CONT_RET)+4-SCM_type_SUBTYPED)
  2961.     movl    PVM2_REG,DISP(ATEMP1,SLOT(TASK_CONT_FRAME)+4-SCM_type_SUBTYPED)
  2962.     movl    DISP(PSTATE_REG,SLOT(CURRENT_DYN_ENV)),DISP(ATEMP1,SLOT(TASK_CONT_DYN_ENV)+4-SCM_type_SUBTYPED)
  2963.     movl    FALSE_REG,DISP(ATEMP1,SLOT(TASK_VALUE)+4-SCM_type_SUBTYPED)
  2964.  
  2965.     movl    ATEMP1,PDEC(HEAP_REG)
  2966.     movl    HEAP_REG,PVM3_REG
  2967.  
  2968. /* Final check for determinedness. */
  2969.  
  2970.     btst    PVM4_REG,PLACEHOLDER_REG
  2971.     BNES(    already_determined)
  2972.  
  2973.     movl    PVM4_REG,ATEMP2
  2974.     lea    DISP(ATEMP2,SLOT(PH_QUEUE)-SCM_type_PLACEHOLDER),ATEMP2
  2975.  
  2976.     LOCK_ATEMP2(lock2)
  2977.  
  2978.     CMPL(    DTEMP1,FALSE_REG)
  2979.     BNES(    undetermined)
  2980.  
  2981.     movl    DTEMP1,IND(ATEMP2)
  2982.     movl    DISP(ATEMP2,SLOT(PH_VALUE-PH_QUEUE)),PVM4_REG
  2983.  
  2984. LBL(already_determined):
  2985.     addql    IMM(4),HEAP_REG
  2986.  
  2987. /* Resume task. */
  2988.  
  2989.     movl    DISP(PSTATE_REG,SLOT(CURRENT_TASK)),ATEMP2
  2990.     movl    DISP(ATEMP2,SLOT(TASK_CONT_RET)+4-SCM_type_SUBTYPED),DISP(PSTATE_REG,SLOT(PARENT_RET))
  2991.     movl    DISP(ATEMP2,SLOT(TASK_CONT_FRAME)+4-SCM_type_SUBTYPED),DISP(PSTATE_REG,SLOT(PARENT_FRAME))
  2992.     movl    DISP(ATEMP2,SLOT(TASK_CONT_DYN_ENV)+4-SCM_type_SUBTYPED),DISP(PSTATE_REG,SLOT(CURRENT_DYN_ENV))
  2993.  
  2994. #ifdef debug
  2995. /*****/    pea    PC_IND($entry)
  2996. /*****/    movl    PINC(SP),DISP(PSTATE_REG,SLOT(56))
  2997. /*****/    movl    DISP(PSTATE_REG,SLOT(BOS_RET)),DISP(PSTATE_REG,SLOT(57))
  2998. /*****/    movl    IMM(0),DISP(PSTATE_REG,SLOT(58))
  2999. #endif
  3000.  
  3001.     movl    PVM4_REG,PVM0_REG
  3002.     movl    PVM4_REG,PVM1_REG
  3003.     movl    PVM4_REG,PVM2_REG
  3004.     movl    PVM4_REG,PVM3_REG
  3005.  
  3006.     PREV_LOG(2,log2)
  3007.  
  3008.     movl    DISP(PSTATE_REG,SLOT(BOS_RET)),ATEMP1
  3009.     jmp    IND(ATEMP1)
  3010.  
  3011. LBL(undetermined):
  3012.     movl    DTEMP1,PDEC(HEAP_REG)
  3013.     movl    PVM3_REG,IND(ATEMP2)
  3014.  
  3015.     addql    IMM(8),DISP(PSTATE_REG,SLOT(COUNT2))
  3016.  
  3017. #ifdef MAINTAIN_TASK_STATUS
  3018.  
  3019. /* Change task's status to WAITING */
  3020.  
  3021.     movl    DISP(PSTATE_REG,SLOT(CURRENT_TASK)),ATEMP1
  3022.     movl    NULL_REG,DISP(ATEMP1,SLOT(TASK_STATUS)+4-SCM_type_SUBTYPED)
  3023.  
  3024. /* Resume placeholder's task if possible (i.e. if it is READY) */
  3025.  
  3026.     movl    DISP(ATEMP2,SLOT(PH_TASK-PH_QUEUE)),PVM1_REG
  3027.     movl    CONST(2),ATEMP1
  3028.     jmp    IND(ATEMP1)
  3029.  
  3030. #else
  3031.  
  3032.     moveq    IMM(0),PVM1_REG
  3033.     movl    CONST(2),ATEMP1
  3034.     jmp    IND(ATEMP1)
  3035.  
  3036. #endif
  3037.  
  3038. CONSTS(4)
  3039. PRIMITIVE("###_kernel.transfer-lazy-tasks-to-heap")
  3040. PRIMITIVE("###_kernel.transfer-stack-to-heap")
  3041. PRIMITIVE("###_kernel.idle")
  3042. PRIMITIVE("###_kernel.determine!")
  3043. END
  3044.  
  3045. /*---------------------------------------------------------------------------*/
  3046.  
  3047. #undef LBL
  3048. #define LBL(x)MAKE_LBL(34,x)
  3049.  
  3050. BEGIN("###_kernel.transfer-lazy-task-chunk-to-heap")
  3051.  
  3052. /* On entry:                                                       */
  3053. /*   top of stack = exit address                                   */
  3054. /*   PVM2_REG = processor to respond to or task list               */
  3055. /*   PVM3_REG = stack base                                         */
  3056. /*   ATEMP1 = LTQ_HEAD                                             */
  3057.  
  3058. /* On exit:                                                        */
  3059. /*   PVM2_REG = new task list                                      */
  3060. /*   PVM4_REG preserved                                            */
  3061. /*   PVM0_REG, PVM1_REG, PVM3_REG, DTEMP1, ATEMP1, ATEMP2 modified */
  3062.  
  3063. /* It is assumed that:                                                 */
  3064. /*   - there is at least one lazy task on the lazy task queue          */
  3065. /*   - no GC will be required (there is enough free space in the heap) */
  3066.  
  3067. #ifndef MESSAGE_PASSING_STEAL
  3068.     movl    ATEMP1,PVM1_REG
  3069. #endif
  3070.  
  3071.     addql    IMM(4),ATEMP1    /* adjust LTQ_HEAD as though taking one task */
  3072.  
  3073.     lea    DISP(LTQ_TAIL_REG,-SLOT(MIN_VICTIM_TASKS)),PVM0_REG
  3074.  
  3075.     CMPL(    ATEMP1,PVM0_REG)
  3076.     BLSS(    found_split_point2)
  3077.  
  3078.     movl    DISP(PVM0_REG,-SLOT(1)),DTEMP1
  3079.  
  3080.     movl    PVM3_REG,ATEMP2
  3081.     lea    DISP(ATEMP2,-SLOT(MAX_TASK_FRAME_CHUNK_SIZE)),ATEMP2
  3082.  
  3083.     CMPL(    DTEMP1,ATEMP2)
  3084.     BLSS(    found_split_point1)
  3085.  
  3086. LBL(loop1):
  3087.     CMPL(    PINC(ATEMP1),ATEMP2)
  3088.     BLSS(    loop1)
  3089.  
  3090.     subql    IMM(4),ATEMP1
  3091.     BRAS(    found_split_point2)
  3092.  
  3093. LBL(found_split_point1):
  3094.     movl    PVM0_REG,ATEMP1
  3095. LBL(found_split_point2):
  3096.  
  3097. #ifndef MESSAGE_PASSING_STEAL
  3098.     movl    PVM1_REG,ATEMP2
  3099. LBL(loop2):
  3100.     addql    IMM(4),ATEMP2
  3101.     clrl    DISP(ATEMP2,-SLOT(2))
  3102.     CMPL(    ATEMP2,ATEMP1)
  3103.     BNES(    loop2)
  3104. #endif
  3105.  
  3106.     movl    CONST(0),ATEMP2
  3107.     jmp    IND(ATEMP2)
  3108.  
  3109. CONSTS(1)
  3110. PRIMITIVE("###_kernel.transfer-lazy-task-to-heap")
  3111. END
  3112.  
  3113. /*---------------------------------------------------------------------------*/
  3114.  
  3115. #undef LBL
  3116. #define LBL(x)MAKE_LBL(35,x)
  3117.  
  3118. BEGIN("###_kernel.transfer-lazy-task-to-heap")
  3119.  
  3120. /* On entry:                                                       */
  3121. /*   top of stack = exit address                                   */
  3122. /*   PVM2_REG = processor to respond to or task list               */
  3123. /*   PVM3_REG = stack base                                         */
  3124. /*   ATEMP1 = LTQ split point                                      */
  3125.  
  3126. /* On exit:                                                        */
  3127. /*   PVM2_REG = new task list                                      */
  3128. /*   PVM4_REG preserved                                            */
  3129. /*   PVM0_REG, PVM1_REG, PVM3_REG, DTEMP1, ATEMP1, ATEMP2 modified */
  3130.  
  3131. /* It is assumed that:                                                 */
  3132. /*   - there is at least one lazy task on the lazy task queue          */
  3133. /*   - no GC will be required (there is enough free space in the heap) */
  3134.  
  3135.     movl    ATEMP1,DISP(PSTATE_REG,SLOT(LTQ_HEAD))
  3136.     movl    DISP(ATEMP1,-SLOT(1)),ATEMP2
  3137.     movl    IND(ATEMP2),DTEMP1
  3138.  
  3139. /* DTEMP1 = task's return adr, ATEMP2 = task boundary */
  3140.  
  3141. /* Now, we must replace the child's return address with the 'bottom of stack'*/
  3142. /* return address.  Because we don't really know where the return address    */
  3143. /* is (but we do know its value) we must scan the child's stack until we     */
  3144. /* have found the address.                                                   */
  3145.  
  3146.     movl    ATEMP2,ATEMP1
  3147. LBL(loop1):
  3148.     CMPL(    PDEC(ATEMP1),DTEMP1)
  3149.     BNES(    loop1)
  3150.  
  3151.     movl    DISP(PSTATE_REG,SLOT(BOS_RET)),PVM0_REG
  3152.     movl    PVM0_REG,IND(ATEMP1)
  3153.  
  3154. /* Similarly, replace 'bottom of stack' return address by correct one */
  3155.  
  3156.     movl    PVM3_REG,ATEMP1
  3157. LBL(loop2):
  3158.     CMPL(    PDEC(ATEMP1),PVM0_REG)
  3159.     BNES(    loop2)
  3160.  
  3161.     movl    DISP(PSTATE_REG,SLOT(PARENT_RET)),IND(ATEMP1)
  3162.  
  3163. /* Next, we must find the dynamic environment of the parent. */
  3164.  
  3165.     movl    DISP(PSTATE_REG,SLOT(CURRENT_DYN_ENV)),PDEC(SP) /*guard*/
  3166.     movl    DISP(PSTATE_REG,SLOT(DEQ_TAIL)),PVM0_REG
  3167.     movl    SP,PDEC(PVM0_REG)
  3168.  
  3169.     movl    DISP(PSTATE_REG,SLOT(DEQ_HEAD)),PVM0_REG
  3170. LBL(loop3):
  3171.     CMPL(    PDEC(PVM0_REG),ATEMP2)
  3172.     BCSS(    loop3)
  3173.  
  3174.     addql    IMM(4),PVM0_REG
  3175.     movl    PVM0_REG,DISP(PSTATE_REG,SLOT(DEQ_HEAD))
  3176.  
  3177. /* Setup parent task. */
  3178.  
  3179.     movl    DISP(PSTATE_REG,SLOT(TEMP_TASK)),ATEMP1
  3180.     movl    PDEC(PVM0_REG),PVM0_REG
  3181.     movl    IND(PVM0_REG),DISP(ATEMP1,SLOT(TASK_CONT_DYN_ENV)+4-SCM_type_SUBTYPED)
  3182.     subql    IMM(8),DTEMP1        /* convert return adr to normal one */
  3183.     movl    DTEMP1,DISP(ATEMP1,SLOT(TASK_CONT_RET)+4-SCM_type_SUBTYPED)
  3184.  
  3185. #ifdef MAINTAIN_TASK_STATUS
  3186.  
  3187. /* Link placeholder to current task so that it can get resumed when the */
  3188. /* placeholder is touched (and the task is READY). */
  3189.  
  3190.     movl    DISP(ATEMP1,SLOT(TASK_SYNC_PH)+4-SCM_type_SUBTYPED),PVM0_REG
  3191.     movl    DISP(PSTATE_REG,SLOT(CURRENT_TASK)),DISP(PVM0_REG,SLOT(PH_TASK)-SCM_type_PLACEHOLDER)
  3192.  
  3193. #endif
  3194.  
  3195.     addql    IMM(4),SP
  3196.  
  3197. /* Allocate a single frame object for task's continuation */
  3198.  
  3199. /* Compute size of frame object */
  3200.  
  3201.     subl    ATEMP2,PVM3_REG
  3202.     addql    IMM(4),PVM3_REG
  3203.  
  3204. /* Allocate frame object. */
  3205.  
  3206.     movl    PVM3_REG,PVM1_REG
  3207.     addw    IMM(11),PVM1_REG
  3208.     andw    IMM(-8),PVM1_REG
  3209.     subl    PVM1_REG,HEAP_REG
  3210.     asll    IMM(8),PVM3_REG
  3211.     movb    IMM(SCM_subtype_FRAME*8),PVM3_REG
  3212.     movl    PVM3_REG,IND(HEAP_REG)
  3213.  
  3214.     clrl    DISP(HEAP_REG,SLOT(1))
  3215.     lea    DISP(HEAP_REG,SCM_type_SUBTYPED),PVM0_REG
  3216.     movl    PVM0_REG,DISP(ATEMP1,SLOT(TASK_CONT_FRAME)+4-SCM_type_SUBTYPED)
  3217.  
  3218. /* Make child's continuation frame. */
  3219.  
  3220.     movl    DTEMP1,PDEC(HEAP_REG)
  3221.     movl    ATEMP1,PDEC(HEAP_REG)
  3222.     movl    PVM0_REG,PDEC(HEAP_REG)
  3223.     movl    IMM(3*0x400+(SCM_subtype_FRAME*8)),PDEC(HEAP_REG)
  3224.  
  3225.     movl    PVM0_REG,DTEMP1
  3226.  
  3227. /* Check were parent task should go. */
  3228.  
  3229.     movl    PVM2_REG,PVM1_REG
  3230.     BEQS(    transfer_to_workq)
  3231.  
  3232. /*vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv*/
  3233. #ifdef MESSAGE_PASSING_STEAL
  3234. #ifdef SYNCHRONOUS_STEAL
  3235.  
  3236.     andw    IMM(7),PVM2_REG
  3237.     BNES(    transfer_to_task_list)
  3238.  
  3239. LBL(transfer_to_thief):
  3240.  
  3241. /* Transfer task to thief processor. */
  3242.  
  3243.     movl    PVM1_REG,PVM0_REG
  3244.  
  3245. #ifdef MAINTAIN_TASK_STATUS
  3246.  
  3247. /* Change task's status to RUNNING */
  3248.  
  3249.     movl    PVM0_REG,DISP(ATEMP1,SLOT(TASK_STATUS)+4-SCM_type_SUBTYPED)
  3250.  
  3251. #endif
  3252.  
  3253.     movl    ATEMP1,DISP(PVM0_REG,SLOT(RESPONSE))
  3254.  
  3255.     BRAS(    copy_stack)
  3256.  
  3257. LBL(transfer_to_task_list):
  3258.  
  3259. #endif
  3260. #endif
  3261. /*^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^*/
  3262.  
  3263. /* Add parent task to head of task list. */
  3264.  
  3265.     movl    ATEMP1,PDEC(HEAP_REG)
  3266.  
  3267. #ifdef MAINTAIN_TASK_STATUS
  3268.  
  3269. /* Change task's status to READY */
  3270.  
  3271.     movl    HEAP_REG,DISP(ATEMP1,SLOT(TASK_STATUS)+4-SCM_type_SUBTYPED)
  3272.  
  3273. #endif
  3274.  
  3275.     movl    HEAP_REG,PVM2_REG
  3276.     movl    PVM1_REG,PDEC(HEAP_REG)
  3277.  
  3278.     BRAS(    copy_stack)
  3279.  
  3280. LBL(transfer_to_workq):
  3281.  
  3282. /* Add parent task to workq. */
  3283.  
  3284.     movl    ATEMP1,PDEC(HEAP_REG)
  3285.  
  3286. #ifdef MAINTAIN_TASK_STATUS
  3287.  
  3288. /* Change task's status to READY */
  3289.  
  3290.     movl    HEAP_REG,DISP(ATEMP1,SLOT(TASK_STATUS)+4-SCM_type_SUBTYPED)
  3291.  
  3292. #endif
  3293.  
  3294.     movl    FALSE_REG,DISP(PSTATE_REG,SLOT(WORKQ_LOCKO))
  3295. LBL(lock_workq):
  3296.     tstl    DISP(PSTATE_REG,SLOT(WORKQ_LOCKV))
  3297.     BNES(    lock_workq)
  3298.  
  3299.     movl    DISP(PSTATE_REG,SLOT(WORKQ_TAIL)),ATEMP1
  3300.     CMPL(    ATEMP1,NULL_REG)
  3301.     BNES(    non_empty_queue)
  3302.     movl    HEAP_REG,DISP(PSTATE_REG,SLOT(WORKQ_HEAD))
  3303.     BRAS(    fix_tail)
  3304. LBL(non_empty_queue):
  3305.     movl    HEAP_REG,PDEC(ATEMP1)
  3306. LBL(fix_tail):
  3307.     movl    HEAP_REG,DISP(PSTATE_REG,SLOT(WORKQ_TAIL))
  3308.  
  3309.     movl    NULL_REG,PDEC(HEAP_REG)
  3310.  
  3311.     clrl    DISP(PSTATE_REG,SLOT(WORKQ_LOCKO))
  3312.  
  3313. LBL(copy_stack):
  3314.  
  3315. /* Copy stack to frame object. */
  3316.  
  3317. /* PVM3_REG=frame_header, ATEMP2=start_of_stack, DTEMP1=frame_object */
  3318.  
  3319.     lsrl    IMM(8),PVM3_REG
  3320.     lsrl    IMM(2),PVM3_REG
  3321.     subql    IMM(2),PVM3_REG
  3322.  
  3323.     movl    DTEMP1,ATEMP1
  3324.     addql    IMM(SLOT(2)-SCM_type_SUBTYPED),ATEMP1
  3325. LBL(copy_loop):
  3326.     movl    PINC(ATEMP2),PINC(ATEMP1)
  3327.     DBRA(    PVM3_REG,copy_loop)
  3328.  
  3329.     movl    DTEMP1,ATEMP1
  3330.     movl    DISP(PSTATE_REG,SLOT(PARENT_FRAME)),DISP(ATEMP1,SLOT(1)-SCM_type_SUBTYPED)
  3331.  
  3332. /* Setup new parent continuation. */
  3333.  
  3334.     lea    DISP(ATEMP1,-SLOT(4)),ATEMP1
  3335.     movl    ATEMP1,DISP(PSTATE_REG,SLOT(PARENT_FRAME))
  3336.     movl    CONST(0),ATEMP1
  3337.     addw    IMM(16),ATEMP1
  3338.     movl    ATEMP1,DISP(PSTATE_REG,SLOT(PARENT_RET))
  3339.  
  3340. #ifdef debug
  3341. /*****/    pea    PC_IND($entry)
  3342. /*****/    movl    PINC(SP),DISP(PSTATE_REG,SLOT(56))
  3343. /*****/    movl    IND(SP),DISP(PSTATE_REG,SLOT(57))
  3344. /*****/    movl    IMM(0),DISP(PSTATE_REG,SLOT(58))
  3345. #endif
  3346.  
  3347. /* Return. */
  3348.  
  3349.     addql    IMM(8),DISP(PSTATE_REG,SLOT(COUNT1))
  3350.  
  3351.     MAKE_TEMP_TASK
  3352.  
  3353.     rts
  3354.  
  3355. CONSTS(1)
  3356. PRIMITIVE("###_kernel.task")
  3357. END
  3358.  
  3359. /*---------------------------------------------------------------------------*/
  3360.  
  3361. #undef LBL
  3362. #define LBL(x)MAKE_LBL(36,x)
  3363.  
  3364. BEGIN("###_kernel.task")
  3365.  
  3366. /* This is the code that is run every time the child's continuation is */
  3367. /* returned from.                                                      */
  3368.  
  3369. RETURN(child_ret,2,1):
  3370.  
  3371. /* First, check if this is the first return from the child. */
  3372.  
  3373.     movl    IND(SP),ATEMP2        /* ATEMP2 = parent task */
  3374.     movl    PVM1_REG,PDEC(SP)
  3375.     movl    ATEMP2,DTEMP1
  3376.     addl    IMM(SLOT(TASK_SYNC_PH)+4-SCM_type_SUBTYPED),DTEMP1
  3377.     READ_AND_CLEAR_DTEMP1
  3378.     btst    DTEMP1,PLACEHOLDER_REG
  3379.     BNES(    not_first_ret)
  3380.  
  3381. /* If it is the first return, determine the synchronization placeholder */
  3382. /* and propagate the legitimacy.                                        */
  3383.  
  3384.     movl    DTEMP1,PDEC(SP)
  3385.  
  3386. #ifdef LEGITIMACY
  3387.  
  3388.     movl    DISP(ATEMP2,SLOT(TASK_LEGIT)+4-SCM_type_SUBTYPED),PVM1_REG
  3389.  
  3390. /* Legitimacy placeholders can be determined with placeholders.        */
  3391. /* So, it is wise to chase the placeholder before doing the determine. */
  3392.  
  3393.     movl    DISP(PSTATE_REG,SLOT(CURRENT_TASK)),ATEMP2
  3394.     movl    DISP(ATEMP2,SLOT(TASK_LEGIT)+4-SCM_type_SUBTYPED),PVM2_REG
  3395. LBL(next):
  3396.     btst    PVM2_REG,PLACEHOLDER_REG
  3397.     BNES(    end_of_chase)
  3398.     movl    PVM2_REG,ATEMP1
  3399.     movl    DISP(ATEMP1,SLOT(PH_VALUE)-SCM_type_PLACEHOLDER),PVM2_REG
  3400.     CMPL(    ATEMP1,PVM2_REG)
  3401.     BNES(    next)
  3402.  
  3403. LBL(end_of_chase):
  3404.     lea    PC_IND(ret),PVM0_REG
  3405.     movl    CONST(0),ATEMP1
  3406.     jmp    IND(ATEMP1)
  3407. RETURN(ret,4,1):
  3408.  
  3409. #endif
  3410.  
  3411. /* Determine value placeholder */
  3412.  
  3413.     movl    PINC(SP),PVM1_REG
  3414.     movl    PINC(SP),PVM2_REG
  3415.     movl    PINC(SP),PVM3_REG
  3416.     movl    PINC(SP),PVM0_REG
  3417.     movl    CONST(1),ATEMP1
  3418.     jmp    IND(ATEMP1)
  3419.  
  3420. LBL(not_first_ret):
  3421.     movl    PINC(SP),PVM1_REG
  3422.     addql    IMM(4),SP
  3423.     rts
  3424.  
  3425. CONSTS(2)
  3426. PRIMITIVE("###_kernel.non-strict-determine!")
  3427. PRIMITIVE("###_kernel.determine!-then-idle")
  3428. END
  3429.  
  3430. /*---------------------------------------------------------------------------*/
  3431.  
  3432. #undef LBL
  3433. #define LBL(x)MAKE_LBL(37,x)
  3434.  
  3435. BEGIN("###_kernel.transfer-lazy-tasks-to-heap")
  3436.  
  3437. /* On entry:                                               */
  3438. /*   top of stack = exit address                           */
  3439.  
  3440. /* On exit:                                                */
  3441. /*   PVM2_REG = task list                                  */
  3442. /*   PVM4_REG preserved                                    */
  3443. /*   PVM0_REG, PVM1_REG, PVM3_REG, DTEMP1, ATEMP2 modified */
  3444.  
  3445. /* We must make sure that there is enough free space for all the frames (so  */
  3446. /* that we can avoid to check for GC on every one).  If each frame is copied */
  3447. /* independently, the heap space required could be as much as 4 times the    */
  3448. /* space used on the stack plus a certain amount for every lazy task.        */
  3449.  
  3450. #ifndef MESSAGE_PASSING_STEAL
  3451.     movl    FALSE_REG,DISP(PSTATE_REG,SLOT(STEAL_LOCKO))
  3452. LBL(lock_steal1):
  3453.     tstl    DISP(PSTATE_REG,SLOT(STEAL_LOCKV))
  3454.     BNES(    lock_steal1)
  3455.     movl    DISP(PSTATE_REG,SLOT(LTQ_HEAD)),ATEMP1
  3456.     movl    DISP(ATEMP1,-SLOT(1)),DTEMP1
  3457.     clrl    DISP(PSTATE_REG,SLOT(STEAL_LOCKO))
  3458. #else
  3459.     movl    DISP(PSTATE_REG,SLOT(LTQ_HEAD)),ATEMP1
  3460.     movl    DISP(ATEMP1,-SLOT(1)),DTEMP1
  3461. #endif
  3462.     subl    SP,DTEMP1
  3463.     asll    IMM(2),DTEMP1
  3464.  
  3465.     movl    LTQ_TAIL_REG,PVM1_REG
  3466.     subl    ATEMP1,PVM1_REG
  3467.     muluw    IMM((TASK_SIZE+1)+(PH_SIZE*2)+PAIR_SIZE+6),PVM1_REG
  3468.  
  3469.     addl    PVM1_REG,DTEMP1
  3470.     andw    IMM(-8),DTEMP1
  3471.  
  3472.     CMPL(    DTEMP1,HEAP_REG)
  3473.     subl    DTEMP1,HEAP_REG    /* allocate space for frames and check heap */
  3474.     BCSS(    do_gc)
  3475.     CMPL(    DISP(PSTATE_REG,SLOT(HEAP_LIM)),HEAP_REG) /* overflow */
  3476.     BCCS(    enough_space)
  3477. LBL(do_gc):
  3478.  
  3479.     moveq    IMM(0),PVM1_REG
  3480.     movl    DTEMP1,PDEC(SP)
  3481.     TRAP(heap_alloc2_trap,alloc,2,1)
  3482.     movl    PINC(SP),DTEMP1
  3483.  
  3484.     CMPL(    DTEMP1,HEAP_REG)
  3485.     subl    DTEMP1,HEAP_REG    /* allocate space for frames and check heap */
  3486.     BCSS(    stack_overflow)
  3487.     CMPL(    DISP(PSTATE_REG,SLOT(HEAP_LIM)),HEAP_REG) /* overflow */
  3488.     BCCS(    enough_space)
  3489. LBL(stack_overflow):
  3490.     addl    DTEMP1,HEAP_REG
  3491.  
  3492. /* continuation must be discarded... */
  3493.  
  3494.     movl    DISP(PSTATE_REG,SLOT(BOS_RET)),PVM0_REG
  3495.  
  3496.     movl    CONST(2),ATEMP1    /* jump to ##exception.stack-overflow proc */
  3497.     moveq    IMM(1),DTEMP1    /* passing 0 argument */
  3498.     jmp    IND(ATEMP1)
  3499.  
  3500. LBL(enough_space):
  3501.     addl    DTEMP1,HEAP_REG
  3502.  
  3503. /* At this point, we know that there is enough free space on the heap to */
  3504. /* copy the frames.                                                      */
  3505.  
  3506. /* Transfer a first task. */
  3507.  
  3508.     movl    NULL_REG,PVM2_REG    /* specify task list up to now */
  3509.  
  3510. #ifndef MESSAGE_PASSING_STEAL
  3511.     movl    FALSE_REG,DISP(PSTATE_REG,SLOT(STEAL_LOCKO))
  3512. LBL(lock_steal2):
  3513.     tstl    DISP(PSTATE_REG,SLOT(STEAL_LOCKV))
  3514.     BNES(    lock_steal2)
  3515.  
  3516. /* fix PARENT_RET if it is a lazy future return point */
  3517.  
  3518.     movl    DISP(PSTATE_REG,SLOT(PARENT_RET)),PVM0_REG
  3519.     tstw    DISP(PVM0_REG,-6)
  3520.     BPLS(    fixed)
  3521.  
  3522.     movl    DISP(PSTATE_REG,SLOT(LTQ_HEAD)),ATEMP1
  3523.     movl    DISP(ATEMP1,-SLOT(1)),ATEMP1
  3524. LBL(loop1):
  3525.     CMPL(    PDEC(ATEMP1),PVM0_REG)
  3526.     BNES(    loop1)
  3527.     movl    DISP(PSTATE_REG,SLOT(BOS_RET)),IND(ATEMP1)
  3528.  
  3529.     movl    CONST(3),PVM0_REG
  3530.     addw    IMM(16),PVM0_REG
  3531.     movl    PVM0_REG,DISP(PSTATE_REG,SLOT(PARENT_RET))
  3532.  
  3533. LBL(fixed):
  3534.  
  3535. #endif
  3536.  
  3537.     movl    DISP(PSTATE_REG,SLOT(LTQ_HEAD)),ATEMP1
  3538.     movl    DISP(ATEMP1,-SLOT(1)),PVM3_REG
  3539.     CMPL(    LTQ_TAIL_REG,ATEMP1)
  3540.     BEQS(    tasks_transferred)
  3541.  
  3542.     addql    IMM(4),ATEMP1    /* adjust LTQ_HEAD by one task */
  3543.  
  3544.     pea    PC_IND(ret)
  3545.     movl    CONST(0),ATEMP2
  3546.     jmp    IND(ATEMP2)
  3547.  
  3548. LBL(ret):
  3549.     movl    PVM2_REG,DISP(PSTATE_REG,SLOT(TEMP1))    /* save first task */
  3550.  
  3551. /* Transfer the rest. */
  3552.  
  3553. LBL(loop2):
  3554.     movl    DISP(PSTATE_REG,SLOT(LTQ_HEAD)),ATEMP1
  3555.     movl    DISP(ATEMP1,-SLOT(1)),PVM3_REG
  3556.     CMPL(    LTQ_TAIL_REG,ATEMP1)
  3557.     BEQS(    done)
  3558.  
  3559.     pea    PC_IND(loop2)
  3560.     movl    CONST(1),ATEMP2
  3561.     jmp    IND(ATEMP2)
  3562.  
  3563. LBL(done):
  3564.  
  3565. /* Put the tasks on the workq. */
  3566.  
  3567.     movl    FALSE_REG,DISP(PSTATE_REG,SLOT(WORKQ_LOCKO))
  3568. LBL(lock_workq):
  3569.     tstl    DISP(PSTATE_REG,SLOT(WORKQ_LOCKV))
  3570.     BNES(    lock_workq)
  3571.  
  3572.     movl    DISP(PSTATE_REG,SLOT(WORKQ_TAIL)),ATEMP1
  3573.     CMPL(    ATEMP1,NULL_REG)
  3574.     BNES(    non_empty_queue)
  3575.     movl    PVM2_REG,DISP(PSTATE_REG,SLOT(WORKQ_HEAD))
  3576.     BRAS(    fix_tail)
  3577. LBL(non_empty_queue):
  3578.     movl    PVM2_REG,PDEC(ATEMP1)
  3579. LBL(fix_tail):
  3580.     movl    DISP(PSTATE_REG,SLOT(TEMP1)),DISP(PSTATE_REG,SLOT(WORKQ_TAIL))
  3581.  
  3582.     clrl    DISP(PSTATE_REG,SLOT(WORKQ_LOCKO))
  3583.  
  3584. LBL(tasks_transferred):
  3585.  
  3586. #ifndef MESSAGE_PASSING_STEAL
  3587.     clrl    DISP(PSTATE_REG,SLOT(STEAL_LOCKO))
  3588. #endif
  3589.  
  3590.     rts
  3591.  
  3592. CONSTS(4)
  3593. PRIMITIVE("###_kernel.transfer-lazy-task-to-heap")
  3594. PRIMITIVE("###_kernel.transfer-lazy-task-chunk-to-heap")
  3595. PRIMITIVE("##exception.stack-overflow")
  3596. PRIMITIVE("###_kernel.task")
  3597. END
  3598.  
  3599. /*---------------------------------------------------------------------------*/
  3600.  
  3601. #undef LBL
  3602. #define LBL(x)MAKE_LBL(38,x)
  3603.  
  3604. BEGIN("###_kernel.transfer-stack-to-heap")
  3605.  
  3606. /* On entry:                                                       */
  3607. /*   top of stack = exit address                                   */
  3608. /*   next on stack = continuation's return address                 */
  3609.  
  3610. /* On exit:                                                        */
  3611. /*   top of stack = continuation's return address                  */
  3612. /*   PVM2_REG = continuation's first frame                         */
  3613. /*   PVM4_REG preserved                                            */
  3614. /*   PVM0_REG, PVM1_REG, PVM3_REG, DTEMP1, ATEMP1, ATEMP2 modified */
  3615.  
  3616. /* It is assumed that:                                                 */
  3617. /*   - no GC will be required (there is enough free space in the heap) */
  3618. /*   - there are no tasks on the stack                                 */
  3619.  
  3620.     movl    DISP(PSTATE_REG,SLOT(BOS_RET)),PVM3_REG
  3621.     lea    DISP(SP,SLOT(1)),ATEMP2
  3622.     movl    PINC(ATEMP2),PVM0_REG
  3623.     CMPL(    PVM0_REG,PVM3_REG)
  3624.     BNES(    non_empty_stack)
  3625.  
  3626.     movl    DISP(PSTATE_REG,SLOT(PARENT_RET)),DISP(SP,SLOT(1))
  3627.     movl    DISP(PSTATE_REG,SLOT(PARENT_FRAME)),PVM2_REG
  3628.  
  3629. #ifdef debug
  3630. /*****/    pea    PC_IND($entry)
  3631. /*****/    movl    PINC(SP),DISP(PSTATE_REG,SLOT(56))
  3632. /*****/    movl    IND(SP),DISP(PSTATE_REG,SLOT(57))
  3633. /*****/    movl    IMM(0),DISP(PSTATE_REG,SLOT(58))
  3634. #endif
  3635.  
  3636.     rts
  3637.  
  3638. LBL(non_empty_stack):
  3639.  
  3640. /* Chunk frames together. */
  3641.  
  3642.     lea    DISP(ATEMP2,SLOT(MAX_FRAME_CHUNK_SIZE)),ATEMP1
  3643.  
  3644.     moveq    IMM(0),PVM1_REG
  3645.     movw    DISP(PVM0_REG,-6),PVM1_REG    /* get fs */
  3646.     BGTS(    normal_ret_a1)
  3647. #ifdef debug
  3648. /*****/    BEQS(    dyn_env_ret_a1)
  3649. /*****/    jmp    3
  3650. /*****/LBL(dyn_env_ret_a1):
  3651. #endif
  3652.     movw    IMM(SLOT(DYN_ENV_FS)),PVM1_REG
  3653. LBL(normal_ret_a1):
  3654.     addl    ATEMP2,PVM1_REG
  3655.     BRAS(    try_to_add_next_frame1)
  3656.  
  3657. LBL(not_bottom_of_stack1):
  3658.     movl    PVM1_REG,ATEMP2
  3659.     moveq    IMM(0),PVM1_REG
  3660.     movw    DISP(PVM0_REG,-6),PVM1_REG    /* get fs */
  3661.     BGTS(    normal_ret_b1)
  3662. #ifdef debug
  3663. /*****/    BEQS(    dyn_env_ret_b1)
  3664. /*****/    jmp    5
  3665. /*****/LBL(dyn_env_ret_b1):
  3666. #endif
  3667.     movw    IMM(SLOT(DYN_ENV_FS)),PVM1_REG
  3668. LBL(normal_ret_b1):
  3669.     addl    ATEMP2,PVM1_REG
  3670.     CMPL(    ATEMP1,PVM1_REG)
  3671.     BHIS(    chunk_found1)
  3672. LBL(try_to_add_next_frame1):
  3673.     addw    DISP(PVM0_REG,-4),ATEMP2    /* add link */
  3674.     movl    IND(ATEMP2),PVM0_REG
  3675.     CMPL(    PVM0_REG,PVM3_REG)        /* bottom of stack? */
  3676.     BNES(    not_bottom_of_stack1)
  3677.     movl    DISP(PSTATE_REG,SLOT(PARENT_RET)),IND(ATEMP2)
  3678.     movl    PVM1_REG,ATEMP2
  3679.  
  3680. LBL(chunk_found1):  /* ATEMP2 = chunk's upper limit */
  3681.  
  3682. /* Now, compute size of frame object to hold chunk. */
  3683.  
  3684.     movl    ATEMP2,PVM1_REG
  3685.     lea    DISP(ATEMP1,-SLOT(MAX_FRAME_CHUNK_SIZE)),ATEMP2
  3686.     subl    ATEMP2,PVM1_REG
  3687.     addql    IMM(4),PVM1_REG
  3688.  
  3689. /* Allocate frame object. */
  3690.  
  3691.     movl    PVM1_REG,DTEMP1
  3692.     addw    IMM(11),DTEMP1
  3693.     andw    IMM(-8),DTEMP1
  3694.     subl    DTEMP1,HEAP_REG
  3695.     asll    IMM(8),PVM1_REG
  3696.     movb    IMM(SCM_subtype_FRAME*8),PVM1_REG
  3697.     movl    PVM1_REG,IND(HEAP_REG)
  3698.  
  3699. /* Remember where first frame object is. */
  3700.  
  3701.     movl    HEAP_REG,PVM2_REG
  3702.     addql    IMM(SCM_type_SUBTYPED),PVM2_REG
  3703.  
  3704. LBL(copy_stack):
  3705.  
  3706. /* Copy stack to frame object. */
  3707.  
  3708. /* PVM1_REG=frame_header, ATEMP2=start_of_chunk, HEAP_REG=frame_object */
  3709.  
  3710.     lsrl    IMM(8),PVM1_REG
  3711.     lsrl    IMM(2),PVM1_REG
  3712.     subql    IMM(2),PVM1_REG
  3713.  
  3714.     lea    DISP(HEAP_REG,SLOT(2)),ATEMP1
  3715. LBL(copy_loop):
  3716.     movl    PINC(ATEMP2),PINC(ATEMP1)
  3717.     DBRA(    PVM1_REG,copy_loop)
  3718.  
  3719.     CMPL(    PVM0_REG,PVM3_REG)        /* bottom of stack? */
  3720.     BNES(    next_chunks)
  3721.  
  3722.     movl    DISP(PSTATE_REG,SLOT(PARENT_FRAME)),DISP(HEAP_REG,SLOT(1))
  3723.     rts
  3724.  
  3725. LBL(next_chunks):
  3726.  
  3727. /* Process next chunk(s). */
  3728.  
  3729.     lea    DISP(ATEMP2,SLOT(MAX_FRAME_CHUNK_SIZE)),ATEMP1
  3730.  
  3731.     moveq    IMM(0),PVM1_REG
  3732.     movw    DISP(PVM0_REG,-6),PVM1_REG    /* get fs */
  3733.     BGTS(    normal_ret_a2)
  3734. #ifdef debug
  3735. /*****/    BEQS(    dyn_env_ret_a2)
  3736. /*****/    jmp    7
  3737. /*****/LBL(dyn_env_ret_a2):
  3738. #endif
  3739.     movw    IMM(SLOT(DYN_ENV_FS)),PVM1_REG
  3740. LBL(normal_ret_a2):
  3741.     addl    ATEMP2,PVM1_REG
  3742.     BRAS(    try_to_add_next_frame2)
  3743.  
  3744. LBL(not_bottom_of_stack2):
  3745.     movl    PVM1_REG,ATEMP2
  3746.     moveq    IMM(0),PVM1_REG
  3747.     movw    DISP(PVM0_REG,-6),PVM1_REG    /* get fs */
  3748.     BGTS(    normal_ret_b2)
  3749. #ifdef debug
  3750. /*****/    BEQS(    dyn_env_ret_b2)
  3751. /*****/    jmp    9
  3752. /*****/LBL(dyn_env_ret_b2):
  3753. #endif
  3754.     movw    IMM(SLOT(DYN_ENV_FS)),PVM1_REG
  3755. LBL(normal_ret_b2):
  3756.     addl    ATEMP2,PVM1_REG
  3757.     CMPL(    ATEMP1,PVM1_REG)
  3758.     BHIS(    chunk_found2)
  3759. LBL(try_to_add_next_frame2):
  3760.     addw    DISP(PVM0_REG,-4),ATEMP2    /* add link */
  3761.     movl    IND(ATEMP2),PVM0_REG
  3762.     CMPL(    PVM0_REG,PVM3_REG)        /* bottom of stack? */
  3763.     BNES(    not_bottom_of_stack2)
  3764.     movl    DISP(PSTATE_REG,SLOT(PARENT_RET)),IND(ATEMP2)
  3765.     movl    PVM1_REG,ATEMP2
  3766.  
  3767. LBL(chunk_found2):  /* ATEMP2 = chunk's upper limit */
  3768.  
  3769. /* Now, compute size of frame object to hold chunk. */
  3770.  
  3771.     movl    ATEMP2,PVM1_REG
  3772.     lea    DISP(ATEMP1,-SLOT(MAX_FRAME_CHUNK_SIZE)),ATEMP2
  3773.     subl    ATEMP2,PVM1_REG
  3774.     addql    IMM(4),PVM1_REG
  3775.  
  3776. /* Remember previous frame object */
  3777.  
  3778.     movl    HEAP_REG,ATEMP1
  3779.  
  3780. /* Allocate frame object. */
  3781.  
  3782.     movl    PVM1_REG,DTEMP1
  3783.     addw    IMM(11),DTEMP1
  3784.     andw    IMM(-8),DTEMP1
  3785.     subl    DTEMP1,HEAP_REG
  3786.     asll    IMM(8),PVM1_REG
  3787.     movb    IMM(SCM_subtype_FRAME*8),PVM1_REG
  3788.     movl    PVM1_REG,IND(HEAP_REG)
  3789.  
  3790. /* Link with previous frame object */
  3791.  
  3792.     addql    IMM(SCM_type_SUBTYPED),HEAP_REG
  3793.     movl    HEAP_REG,DISP(ATEMP1,SLOT(1))
  3794.     subql    IMM(SCM_type_SUBTYPED),HEAP_REG
  3795.  
  3796.     BRAW(    copy_stack)
  3797.  
  3798. CONSTS(0)
  3799. END
  3800.  
  3801. /*---------------------------------------------------------------------------*/
  3802.  
  3803. #undef LBL
  3804. #define LBL(x)MAKE_LBL(39,x)
  3805.  
  3806. BEGIN("###_kernel.flush-stack")
  3807.  
  3808.     movl    PVM0_REG,PDEC(SP)
  3809.  
  3810. /* Call ###_kernel.transfer-lazy-tasks-to-heap. */
  3811.  
  3812.     pea    PC_IND(ret1)
  3813.     movl    CONST(0),ATEMP1
  3814.     jmp    IND(ATEMP1)
  3815. RETURN(ret1,1,1):
  3816.  
  3817. /* Call ###_kernel.transfer-stack-to-heap. */
  3818.  
  3819. /* ###_kernel.transfer-lazy-tasks-to-heap has reserved enough */
  3820. /* space, so no GC check required.                            */
  3821.  
  3822.     pea    PC_IND(ret2)
  3823.     movl    CONST(1),ATEMP1
  3824.     jmp    IND(ATEMP1)
  3825. LBL(ret2):
  3826.  
  3827. /* Setup 'hidden' parent continuation. */
  3828.  
  3829.     movl    IND(SP),DISP(PSTATE_REG,SLOT(PARENT_RET))
  3830.     movl    PVM2_REG,DISP(PSTATE_REG,SLOT(PARENT_FRAME))
  3831.  
  3832. #ifdef debug
  3833. /*****/    pea    PC_IND($entry)
  3834. /*****/    movl    PINC(SP),DISP(PSTATE_REG,SLOT(56))
  3835. /*****/    movl    DISP(PSTATE_REG,SLOT(BOS_RET)),DISP(PSTATE_REG,SLOT(57))
  3836. /*****/    movl    IMM(0),DISP(PSTATE_REG,SLOT(58))
  3837. #endif
  3838.  
  3839. /* Return to parent */
  3840.  
  3841.     moveq    IMM(0),PVM1_REG
  3842.     movl    PVM1_REG,PVM2_REG
  3843.     movl    PVM1_REG,PVM3_REG
  3844.  
  3845.     movl    DISP(PSTATE_REG,SLOT(BOS_RET)),PVM0_REG
  3846.     jmp    IND(PVM0_REG)
  3847.  
  3848. CONSTS(2)
  3849. PRIMITIVE("###_kernel.transfer-lazy-tasks-to-heap")
  3850. PRIMITIVE("###_kernel.transfer-stack-to-heap")
  3851. END
  3852.  
  3853. /*---------------------------------------------------------------------------*/
  3854.  
  3855. #undef LBL
  3856. #define LBL(x)MAKE_LBL(40,x)
  3857.  
  3858. BEGIN("##call-with-current-continuation")
  3859.  
  3860.     BMIS(    passed_1arg)
  3861.  
  3862.     WRONG_NB_ARGS(wrong_nb_arg1_trap,1,$entry)
  3863.  
  3864. LBL(passed_1arg):
  3865.  
  3866.     movl    PVM1_REG,PVM4_REG
  3867.     movl    PVM0_REG,PDEC(SP)
  3868.  
  3869. /* Call ###_kernel.transfer-lazy-tasks-to-heap. */
  3870.  
  3871.     pea    PC_IND(ret1)
  3872.     movl    CONST(0),ATEMP1
  3873.     jmp    IND(ATEMP1)
  3874. RETURN(ret1,1,1):
  3875.  
  3876. /* Call ###_kernel.transfer-stack-to-heap. */
  3877.  
  3878. /* ###_kernel.transfer-lazy-tasks-to-heap has reserved enough */
  3879. /* space, so no GC check required.                            */
  3880.  
  3881.     pea    PC_IND(ret2)
  3882.     movl    CONST(1),ATEMP1
  3883.     jmp    IND(ATEMP1)
  3884. LBL(ret2):
  3885.  
  3886. /* Setup 'hidden' parent continuation. */
  3887.  
  3888.     movl    PINC(SP),PVM0_REG
  3889.     movl    PVM0_REG,DISP(PSTATE_REG,SLOT(PARENT_RET))
  3890.     movl    PVM2_REG,DISP(PSTATE_REG,SLOT(PARENT_FRAME))
  3891.  
  3892. #ifdef debug
  3893. /*****/    pea    PC_IND($entry)
  3894. /*****/    movl    PINC(SP),DISP(PSTATE_REG,SLOT(56))
  3895. /*****/    movl    DISP(PSTATE_REG,SLOT(BOS_RET)),DISP(PSTATE_REG,SLOT(57))
  3896. /*****/    movl    IMM(0),DISP(PSTATE_REG,SLOT(58))
  3897. #endif
  3898.  
  3899. /* Return to parent */
  3900.  
  3901.     movl    DISP(PSTATE_REG,SLOT(BOS_RET)),PDEC(SP)
  3902.  
  3903.     moveq    IMM(0),PVM1_REG
  3904.     movl    PVM1_REG,PVM3_REG
  3905.  
  3906. /* Allocate closure for 'first-class' continuation. */
  3907.  
  3908.     movl    DISP(PSTATE_REG,SLOT(CLOSURE_PTR)),ATEMP2
  3909.     moveq    IMM(32),DTEMP1
  3910.     subl    DTEMP1,ATEMP2
  3911.     CMPL(    DISP(PSTATE_REG,SLOT(CLOSURE_LIM)),ATEMP2)
  3912.     BCCS(    closure_allocated)
  3913.  
  3914.     moveq    IMM(0),PVM1_REG
  3915.     TRAP(closure_alloc_trap,closure_alloc,1,1)
  3916.  
  3917. LBL(closure_allocated):
  3918.     movl    ATEMP2,DISP(PSTATE_REG,SLOT(CLOSURE_PTR))
  3919.  
  3920. /* Init closure. */
  3921.  
  3922.     movw    IMM(0x8010),PINC(ATEMP2)
  3923.     movl    ATEMP2,PVM1_REG
  3924.     addql    IMM(2),ATEMP2
  3925.     lea    PC_IND(closure),ATEMP1
  3926.     movl    ATEMP1,PINC(ATEMP2)
  3927.     movl    PVM0_REG,PINC(ATEMP2)
  3928.     movl    PVM2_REG,PINC(ATEMP2)
  3929.     movl    DISP(PSTATE_REG,SLOT(CURRENT_DYN_ENV)),IND(ATEMP2)
  3930.  
  3931.     movl    PINC(SP),PVM0_REG
  3932.  
  3933.     movl    PVM4_REG,ATEMP1
  3934.     moveq    IMM(-1),DTEMP1
  3935.     jmp    IND(ATEMP1)
  3936.  
  3937. /* This code is executed when the 'first-class' continuation is restored. */
  3938.  
  3939. SUBPROC(closure):
  3940.     movl    PINC(SP),CLOSURE_REG
  3941.     subql    IMM(6),CLOSURE_REG
  3942.     tstw    DTEMP1
  3943.  
  3944.     BMIS(    closure_was_passed_1arg)
  3945.  
  3946.     WRONG_NB_ARGS(wrong_nb_arg1_closed_trap,1,closure)
  3947.  
  3948. LBL(closure_was_passed_1arg):
  3949.  
  3950. /* Call ###_kernel.transfer-lazy-tasks-to-heap. */
  3951.  
  3952.     CMPL(    DISP(PSTATE_REG,SLOT(LTQ_HEAD)),LTQ_TAIL_REG)
  3953.     BEQS(    tasks_transferred)
  3954.  
  3955.     movl    PVM0_REG,PDEC(SP)
  3956.     movl    PVM1_REG,PDEC(SP)
  3957.     pea    PC_IND(ret3)
  3958.     movl    CONST(0),ATEMP1
  3959.     jmp    IND(ATEMP1)
  3960. RETURN(ret3,2,1):
  3961.     movl    PINC(SP),PVM1_REG
  3962.     movl    PINC(SP),PVM0_REG
  3963.     moveq    IMM(0),PVM3_REG
  3964.  
  3965. LBL(tasks_transferred):
  3966.  
  3967. /* Setup 'hidden' parent continuation. */
  3968.  
  3969.     movl    CLOSURE_REG,ATEMP1
  3970.     movl    DISP(ATEMP1,6),DISP(PSTATE_REG,SLOT(PARENT_RET))
  3971.     movl    DISP(ATEMP1,10),DISP(PSTATE_REG,SLOT(PARENT_FRAME))
  3972.     movl    DISP(ATEMP1,14),DISP(PSTATE_REG,SLOT(CURRENT_DYN_ENV))
  3973.  
  3974. #ifdef debug
  3975. /*****/    pea    PC_IND($entry)
  3976. /*****/    movl    PINC(SP),DISP(PSTATE_REG,SLOT(56))
  3977. /*****/    movl    DISP(PSTATE_REG,SLOT(BOS_RET)),DISP(PSTATE_REG,SLOT(57))
  3978. /*****/    movl    IMM(0),DISP(PSTATE_REG,SLOT(58))
  3979. #endif
  3980.  
  3981. /* Restore parent continuation. */
  3982.  
  3983.     movl    DISP(PSTATE_REG,SLOT(BOS_RET)),ATEMP1
  3984.     jmp    IND(ATEMP1)
  3985.  
  3986. CONSTS(2)
  3987. PRIMITIVE("###_kernel.transfer-lazy-tasks-to-heap")
  3988. PRIMITIVE("###_kernel.transfer-stack-to-heap")
  3989. END
  3990.  
  3991. /*---------------------------------------------------------------------------*/
  3992.  
  3993. #undef LBL
  3994. #define LBL(x)MAKE_LBL(41,x)
  3995.  
  3996. BEGIN("##apply")
  3997.  
  3998.     BEQS(    passed_2args)
  3999.  
  4000.     WRONG_NB_ARGS(wrong_nb_arg1_trap,2,$entry)
  4001.  
  4002. LBL(passed_2args):
  4003.     movl    PVM1_REG,ATEMP1
  4004.     movl    PVM2_REG,PVM3_REG
  4005.  
  4006.     moveq    IMM(0),DTEMP1
  4007.     BRAS(    loop_entry)
  4008.  
  4009. /* copy values from list to the stack */
  4010.  
  4011. LBL(loop):
  4012.     movl    PVM3_REG,ATEMP2
  4013.     movl    IND(ATEMP2),PDEC(SP)    /* push car to the stack */
  4014.     movl    PDEC(ATEMP2),PVM3_REG    /* get cdr */
  4015.  
  4016.     addqw    IMM(1),DTEMP1
  4017.     CMPW(    IMM(MAX_NB_ARGS),DTEMP1)
  4018.     BGTS(    max_args_reached)
  4019.  
  4020. LBL(loop_entry):
  4021.     btst    PVM3_REG,PAIR_REG    /* pair? */
  4022.     BEQS(    loop)
  4023.  
  4024.     moveq    IMM(0),INTR_TIMER_REG    /* check interrupts as soon as possible */
  4025.  
  4026.     tstw    DTEMP1            /* how many arguments to pass? */
  4027.     BEQS(    pass_0arg)
  4028.     subqw    IMM(2),DTEMP1
  4029.     BMIS(    pass_1arg)
  4030.     BEQS(    pass_2args)
  4031.  
  4032.     movl    PINC(SP),PVM3_REG
  4033.     movl    PINC(SP),PVM2_REG
  4034.     movl    PINC(SP),PVM1_REG
  4035.     addqw    IMM(3),DTEMP1
  4036.     jmp    IND(ATEMP1)        /* jump to procedure (with >= 3 args) */
  4037.  
  4038. LBL(pass_0arg):
  4039.     moveq    IMM(1),DTEMP1
  4040.     jmp    IND(ATEMP1)        /* jump to procedure (with no arg) */
  4041.  
  4042. LBL(pass_1arg):
  4043.     movl    PINC(SP),PVM1_REG
  4044.     moveq    IMM(-1),DTEMP1
  4045.     jmp    IND(ATEMP1)        /* jump to procedure (with 1 arg) */
  4046.  
  4047. LBL(pass_2args):
  4048.     movl    PINC(SP),PVM2_REG
  4049.     movl    PINC(SP),PVM1_REG
  4050.     moveq    IMM(0),DTEMP1
  4051.     jmp    IND(ATEMP1)        /* jump to procedure (with 2 args) */
  4052.  
  4053. LBL(max_args_reached):
  4054.     aslw    IMM(2),DTEMP1
  4055.     addw    DTEMP1,SP        /* restore original SP */
  4056.  
  4057.     movl    CONST(0),ATEMP1        /* jump to ##exception.apply-arg-limit */
  4058.     moveq    IMM(0),DTEMP1        /* passing 2 arguments */
  4059.     jmp    IND(ATEMP1)
  4060.  
  4061. CONSTS(1)
  4062. PRIMITIVE("##exception.apply-arg-limit")
  4063. END
  4064.  
  4065. /*---------------------------------------------------------------------------*/
  4066.  
  4067. #undef LBL
  4068. #define LBL(x)MAKE_LBL(42,x)
  4069.  
  4070. BEGIN("##global-var")
  4071.  
  4072.     BMIS(    passed_1arg)
  4073.  
  4074.     WRONG_NB_ARGS(wrong_nb_arg1_trap,1,$entry)
  4075.  
  4076. LBL(passed_1arg):
  4077.     movl    PVM1_REG,ATEMP2
  4078.     movl    DISP(ATEMP2,SLOT(SYMBOL_GLOBAL)+4-SCM_type_SUBTYPED),PVM1_REG
  4079.  
  4080.     CMPL(    PVM1_REG,FALSE_REG)
  4081.     BEQS(    alloc_glob)
  4082.  
  4083.     jmp    IND(PVM0_REG)
  4084.  
  4085. LBL(alloc_glob):
  4086.     movl    DISP(TABLE_REG,GLOB_OFFS(GLOBAL_VAR_COUNT)),ATEMP1
  4087.     movl    ATEMP1,PVM1_REG
  4088.     addql    IMM(8),ATEMP1
  4089.     CMPL(    IMM(MAX_NB_GLOBALS*8),ATEMP1)
  4090.     BLES(    ok)
  4091.  
  4092.     movl    FALSE_REG,PVM1_REG
  4093.     jmp    IND(PVM0_REG)
  4094.  
  4095. LBL(ok):
  4096.     movl    ATEMP1,DISP(TABLE_REG,GLOB_OFFS(GLOBAL_VAR_COUNT))
  4097.     movl    PVM1_REG,DISP(ATEMP2,SLOT(SYMBOL_GLOBAL)+4-SCM_type_SUBTYPED)
  4098.  
  4099.     jmp    IND(PVM0_REG)
  4100.  
  4101. CONSTS(0)
  4102. END
  4103.  
  4104. /*---------------------------------------------------------------------------*/
  4105.  
  4106. #undef LBL
  4107. #define LBL(x)MAKE_LBL(43,x)
  4108.  
  4109. BEGIN("##global-var-ref")
  4110.  
  4111.     BMIS(    passed_1arg)
  4112.  
  4113.     WRONG_NB_ARGS(wrong_nb_arg1_trap,1,$entry)
  4114.  
  4115. LBL(passed_1arg):
  4116.     movl    PVM1_REG,ATEMP1
  4117.     addl    TABLE_REG,ATEMP1
  4118.     subl    IMM((NB_TRAPS*8-0x8000)+(MAX_NB_GLOBALS*10)),ATEMP1
  4119.  
  4120.     movl    IND(ATEMP1),PVM1_REG
  4121.     jmp    IND(PVM0_REG)
  4122.  
  4123. CONSTS(0)
  4124. END
  4125.  
  4126. /*---------------------------------------------------------------------------*/
  4127.  
  4128. #undef LBL
  4129. #define LBL(x)MAKE_LBL(44,x)
  4130.  
  4131. BEGIN("##global-var-set!")
  4132.  
  4133.     BEQS(    passed_2args)
  4134.  
  4135.     WRONG_NB_ARGS(wrong_nb_arg1_trap,2,$entry)
  4136.  
  4137. LBL(passed_2args):
  4138.     movl    PVM1_REG,DTEMP1
  4139.     asrl    IMM(2),DTEMP1
  4140.     addl    TABLE_REG,DTEMP1
  4141.     subl    IMM(NB_TRAPS*8-0x8000),DTEMP1
  4142.     subl    IMM(MAX_NB_GLOBALS*2),DTEMP1
  4143.  
  4144.     movl    PVM1_REG,ATEMP1
  4145.     addl    TABLE_REG,ATEMP1
  4146.     subl    IMM(NB_TRAPS*8-0x8000),ATEMP1
  4147.     subl    IMM(MAX_NB_GLOBALS*10),ATEMP1
  4148.  
  4149.     movl    PVM2_REG,PINC(ATEMP1)
  4150.     movl    DTEMP1,IND(ATEMP1)
  4151.  
  4152.     jmp    IND(PVM0_REG)
  4153.  
  4154. CONSTS(0)
  4155. END
  4156.  
  4157. /*---------------------------------------------------------------------------*/
  4158.  
  4159. #undef LBL
  4160. #define LBL(x)MAKE_LBL(45,x)
  4161.  
  4162. BEGIN("##make-vector")
  4163.  
  4164.     BEQS(    passed_2args)
  4165.  
  4166.     WRONG_NB_ARGS(wrong_nb_arg1_trap,2,$entry)
  4167.  
  4168. LBL(passed_2args):
  4169.     movl    PVM1_REG,DTEMP1
  4170.     asrl    IMM(1),DTEMP1
  4171.     addl    IMM(11),DTEMP1
  4172.     andw    IMM(-8),DTEMP1    /* DTEMP1 = total bytes needed for vector */
  4173.  
  4174.     CMPL(    DTEMP1,HEAP_REG)
  4175.     subl    DTEMP1,HEAP_REG    /* allocate space for vector and check heap overflow */
  4176.     BCSS(    gc)
  4177.     CMPL(    DISP(PSTATE_REG,SLOT(HEAP_LIM)),HEAP_REG)
  4178.     BCCS(    ok)
  4179. LBL(gc):
  4180.     movl    PVM0_REG,PDEC(SP)
  4181.     TRAP(heap_alloc2_trap,alloc1,1,1)
  4182.     movl    PINC(SP),PVM0_REG
  4183.  
  4184. LBL(ok):
  4185.     movl    PVM1_REG,DTEMP1
  4186.     asll    IMM(7),DTEMP1
  4187.     movb    IMM(SCM_subtype_VECTOR*8),DTEMP1
  4188.     movl    DTEMP1,IND(HEAP_REG)
  4189.  
  4190. /* init vector: */
  4191.  
  4192.     movl    PVM1_REG,DTEMP1
  4193.     asrl    IMM(1),DTEMP1
  4194.     lea    DISP(HEAP_REG,4),ATEMP1
  4195. LBL(loop):
  4196.     movl    PVM2_REG,PINC(ATEMP1)
  4197.     subql    IMM(4),DTEMP1
  4198.     BGTS(    loop)
  4199.  
  4200.     movl    HEAP_REG,PVM1_REG
  4201.     addql    IMM(SCM_type_SUBTYPED),PVM1_REG
  4202.  
  4203.     jmp    IND(PVM0_REG)        /* return to caller */
  4204.  
  4205. CONSTS(0)
  4206. END
  4207.  
  4208. /*---------------------------------------------------------------------------*/
  4209.  
  4210. #undef LBL
  4211. #define LBL(x)MAKE_LBL(46,x)
  4212.  
  4213. BEGIN("##make-string")
  4214.  
  4215.     BEQS(    passed_2args)
  4216.  
  4217.     WRONG_NB_ARGS(wrong_nb_arg1_trap,2,$entry)
  4218.  
  4219. LBL(passed_2args):
  4220.     movl    PVM1_REG,DTEMP1
  4221.     asrl    IMM(3),DTEMP1
  4222.     addl    IMM(11),DTEMP1
  4223.     andw    IMM(-8),DTEMP1    /* DTEMP1 = total bytes needed for string */
  4224.  
  4225.     CMPL(    DTEMP1,HEAP_REG)
  4226.     subl    DTEMP1,HEAP_REG    /* allocate space for string and check heap overflow */
  4227.     BCSS(    gc)
  4228.     CMPL(    DISP(PSTATE_REG,SLOT(HEAP_LIM)),HEAP_REG)
  4229.     BCCS(    ok)
  4230. LBL(gc):
  4231.     movl    PVM0_REG,PDEC(SP)
  4232.     TRAP(heap_alloc2_trap,alloc1,1,1)
  4233.     movl    PINC(SP),PVM0_REG
  4234.  
  4235. LBL(ok):
  4236.     movl    PVM1_REG,DTEMP1
  4237.     asll    IMM(5),DTEMP1
  4238.     movb    IMM(SCM_subtype_STRING*8),DTEMP1
  4239.     movl    DTEMP1,IND(HEAP_REG)
  4240.  
  4241. /* init string: */
  4242.  
  4243.     movl    PVM2_REG,DTEMP1
  4244.     asrw    IMM(3),DTEMP1
  4245.     andw    IMM(0xff),DTEMP1
  4246.     movw    DTEMP1,ATEMP2
  4247.     aslw    IMM(8),DTEMP1
  4248.     addw    ATEMP2,DTEMP1
  4249.     movw    DTEMP1,ATEMP2
  4250.     swap    DTEMP1
  4251.     movw    ATEMP2,DTEMP1
  4252.     movl    DTEMP1,ATEMP2        /* ATEMP2 = initial value of chars */
  4253.  
  4254.     movl    PVM1_REG,DTEMP1
  4255.     asrl    IMM(3),DTEMP1
  4256.     lea    DISP(HEAP_REG,4),ATEMP1
  4257. LBL(loop):
  4258.     movl    ATEMP2,PINC(ATEMP1)
  4259.     subql    IMM(4),DTEMP1
  4260.     BGTS(    loop)
  4261.  
  4262.     movl    HEAP_REG,PVM1_REG
  4263.     addql    IMM(SCM_type_SUBTYPED),PVM1_REG
  4264.  
  4265.     jmp    IND(PVM0_REG)        /* return to caller */
  4266.  
  4267. CONSTS(0)
  4268. END
  4269.  
  4270. /*---------------------------------------------------------------------------*/
  4271.  
  4272. #undef LBL
  4273. #define LBL(x)MAKE_LBL(47,x)
  4274.  
  4275. BEGIN("##make-vector16")
  4276.  
  4277.     BEQS(    passed_2args)
  4278.  
  4279.     WRONG_NB_ARGS(wrong_nb_arg1_trap,2,$entry)
  4280.  
  4281. LBL(passed_2args):
  4282.     movl    PVM1_REG,DTEMP1
  4283.     asrl    IMM(2),DTEMP1
  4284.     addl    IMM(11),DTEMP1
  4285.     andw    IMM(-8),DTEMP1    /* DTEMP1 = total bytes needed for vector */
  4286.  
  4287.     CMPL(    DTEMP1,HEAP_REG)
  4288.     subl    DTEMP1,HEAP_REG    /* allocate space for vector and check heap overflow */
  4289.     BCSS(    gc)
  4290.     CMPL(    DISP(PSTATE_REG,SLOT(HEAP_LIM)),HEAP_REG)
  4291.     BCCS(    ok)
  4292. LBL(gc):
  4293.     movl    PVM0_REG,PDEC(SP)
  4294.     TRAP(heap_alloc2_trap,alloc1,1,1)
  4295.     movl    PINC(SP),PVM0_REG
  4296.  
  4297. LBL(ok):
  4298.     movl    PVM1_REG,DTEMP1
  4299.     asll    IMM(6),DTEMP1
  4300.     movb    IMM(SCM_subtype_STRING*8),DTEMP1
  4301.     movl    DTEMP1,IND(HEAP_REG)
  4302.  
  4303. /* init vector: */
  4304.  
  4305.     movl    PVM2_REG,DTEMP1
  4306.     asrl    IMM(3),DTEMP1
  4307.     movw    DTEMP1,ATEMP2
  4308.     swap    DTEMP1
  4309.     movw    ATEMP2,DTEMP1
  4310.     movl    DTEMP1,ATEMP2        /* ATEMP2 = initial value of words */
  4311.  
  4312.     movl    PVM1_REG,DTEMP1
  4313.     asrl    IMM(2),DTEMP1
  4314.     lea    DISP(HEAP_REG,4),ATEMP1
  4315. LBL(loop):
  4316.     movl    ATEMP2,PINC(ATEMP1)
  4317.     subql    IMM(4),DTEMP1
  4318.     BGTS(    loop)
  4319.  
  4320.     movl    HEAP_REG,PVM1_REG
  4321.     addql    IMM(SCM_type_SUBTYPED),PVM1_REG
  4322.  
  4323.     jmp    IND(PVM0_REG)        /* return to caller */
  4324.  
  4325. CONSTS(0)
  4326. END
  4327.  
  4328. /*---------------------------------------------------------------------------*/
  4329.  
  4330. #undef LBL
  4331. #define LBL(x)MAKE_LBL(48,x)
  4332.  
  4333. BEGIN("##dynamic-env-bind")
  4334.  
  4335.     BEQS(    passed_2args)
  4336.  
  4337.     WRONG_NB_ARGS(wrong_nb_arg1_trap,2,$entry)
  4338.  
  4339. LBL(passed_2args):
  4340.  
  4341. /* save current dynamic environment */
  4342.  
  4343.     movl    PVM0_REG,PDEC(SP)
  4344.     movl    DISP(PSTATE_REG,SLOT(CURRENT_DYN_ENV)),PDEC(SP)
  4345.  
  4346. /* set new dynamic environment */
  4347.  
  4348.     movl    PVM1_REG,DISP(PSTATE_REG,SLOT(CURRENT_DYN_ENV))
  4349.  
  4350. /* push dynamic environment marker (only if none other pushed for this future) */
  4351.  
  4352.     movl    DISP(PSTATE_REG,SLOT(DEQ_TAIL)),ATEMP2
  4353.     movl    IND(ATEMP2),PVM0_REG
  4354.     movl    DISP(LTQ_TAIL_REG,-SLOT(1)),ATEMP1
  4355.     CMPL(    ATEMP1,PVM0_REG)
  4356.     BCSS(    pushed)
  4357.     movl    SP,PDEC(ATEMP2)
  4358.     movl    ATEMP2,DISP(PSTATE_REG,SLOT(DEQ_TAIL))
  4359. LBL(pushed):
  4360.  
  4361.     lea    PC_IND(ret),PVM0_REG
  4362.     movl    PVM2_REG,ATEMP1
  4363.     moveq    IMM(1),DTEMP1
  4364.     jmp    IND(ATEMP1)
  4365.  
  4366. RETURN(ret,DYN_ENV_FS-DYN_ENV_FS,1-DYN_ENV_FS):
  4367. /* A fs of 0 is a special return point marker.  Here it indicates a return */
  4368. /* point for dyn env frames.  The frame size is really 2 (DYN_ENV_FS). */
  4369.  
  4370. /* pop dynamic environment marker */
  4371.  
  4372.     movl    DISP(PSTATE_REG,SLOT(DEQ_TAIL)),ATEMP2
  4373.     movl    PINC(ATEMP2),ATEMP1
  4374.     CMPL(    ATEMP1,SP)
  4375.     BNES(    popped)
  4376.     movl    ATEMP2,DISP(PSTATE_REG,SLOT(DEQ_TAIL))
  4377. LBL(popped):
  4378.  
  4379. /* restore current dynamic environment */
  4380.  
  4381.     movl    PINC(SP),DISP(PSTATE_REG,SLOT(CURRENT_DYN_ENV))
  4382.     rts
  4383.  
  4384. CONSTS(0)
  4385. END
  4386.  
  4387. /*---------------------------------------------------------------------------*/
  4388.  
  4389. #undef LBL
  4390. #define LBL(x)MAKE_LBL(49,x)
  4391.  
  4392. BEGIN("##dynamic-env-ref")
  4393.  
  4394.     CMPW(    IMM(1),DTEMP1)
  4395.     BEQS(    passed_0arg)
  4396.  
  4397.     WRONG_NB_ARGS(wrong_nb_arg1_trap,0,$entry)
  4398.  
  4399. LBL(passed_0arg):
  4400.     movl    DISP(PSTATE_REG,SLOT(CURRENT_DYN_ENV)),PVM1_REG
  4401.     jmp    IND(PVM0_REG)
  4402.  
  4403. CONSTS(0)
  4404. END
  4405.  
  4406. /*---------------------------------------------------------------------------*/
  4407.  
  4408. #undef LBL
  4409. #define LBL(x)MAKE_LBL(50,x)
  4410.  
  4411. BEGIN("##atomic-car")
  4412.  
  4413.     BMIS(    passed_1arg)
  4414.  
  4415.     WRONG_NB_ARGS(wrong_nb_arg1_trap,1,$entry)
  4416.  
  4417. LBL(passed_1arg):
  4418.     andw    IMM(-8),PVM1_REG
  4419.     movl    PVM1_REG,ATEMP2
  4420.  
  4421.     moveq    IMM(-1),DTEMP1
  4422. LBL(loop):
  4423.     movl    DISP(ATEMP2,4),PVM1_REG
  4424.     CMPL(    PVM1_REG,DTEMP1)
  4425.     BEQS(    loop)
  4426.  
  4427.     jmp    IND(PVM0_REG)
  4428.  
  4429. CONSTS(0)
  4430. END
  4431.  
  4432. /*---------------------------------------------------------------------------*/
  4433.  
  4434. #undef LBL
  4435. #define LBL(x)MAKE_LBL(51,x)
  4436.  
  4437. BEGIN("##atomic-set-car!")
  4438.  
  4439.     BEQS(    passed_2args)
  4440.  
  4441.     WRONG_NB_ARGS(wrong_nb_arg1_trap,2,$entry)
  4442.  
  4443. LBL(passed_2args):
  4444.     movl    PVM0_REG,PVM4_REG
  4445.     movl    PVM1_REG,DTEMP1
  4446.     andw    IMM(-8),DTEMP1
  4447.     addql    IMM(4),DTEMP1
  4448.     movl    DTEMP1,ATEMP2
  4449.  
  4450.     LOCK_ATEMP2(lock)
  4451.  
  4452.     movl    PVM2_REG,IND(ATEMP2)
  4453.     movl    DTEMP1,PVM1_REG
  4454.     movl    PVM4_REG,PVM0_REG
  4455.     jmp    IND(PVM0_REG)
  4456.  
  4457. CONSTS(0)
  4458. END
  4459.  
  4460. /*---------------------------------------------------------------------------*/
  4461.  
  4462. #undef LBL
  4463. #define LBL(x)MAKE_LBL(52,x)
  4464.  
  4465. BEGIN("##atomic-cdr")
  4466.  
  4467.     BMIS(    passed_1arg)
  4468.  
  4469.     WRONG_NB_ARGS(wrong_nb_arg1_trap,1,$entry)
  4470.  
  4471. LBL(passed_1arg):
  4472.     andw    IMM(-8),PVM1_REG
  4473.     movl    PVM1_REG,ATEMP2
  4474.  
  4475.     moveq    IMM(-1),DTEMP1
  4476. LBL(loop):
  4477.     movl    IND(ATEMP2),PVM1_REG
  4478.     CMPL(    PVM1_REG,DTEMP1)
  4479.     BEQS(    loop)
  4480.  
  4481.     jmp    IND(PVM0_REG)
  4482.  
  4483. CONSTS(0)
  4484. END
  4485.  
  4486. /*---------------------------------------------------------------------------*/
  4487.  
  4488. #undef LBL
  4489. #define LBL(x)MAKE_LBL(53,x)
  4490.  
  4491. BEGIN("##atomic-set-cdr!")
  4492.  
  4493.     BEQS(    passed_2args)
  4494.  
  4495.     WRONG_NB_ARGS(wrong_nb_arg1_trap,2,$entry)
  4496.  
  4497. LBL(passed_2args):
  4498.     movl    PVM0_REG,PVM4_REG
  4499.     movl    PVM1_REG,DTEMP1
  4500.     andw    IMM(-8),DTEMP1
  4501.     movl    DTEMP1,ATEMP2
  4502.  
  4503.     LOCK_ATEMP2(lock)
  4504.  
  4505.     movl    PVM2_REG,IND(ATEMP2)
  4506.     movl    DTEMP1,PVM1_REG
  4507.     movl    PVM4_REG,PVM0_REG
  4508.     jmp    IND(PVM0_REG)
  4509.  
  4510. CONSTS(0)
  4511. END
  4512.  
  4513. /*---------------------------------------------------------------------------*/
  4514.  
  4515. #undef LBL
  4516. #define LBL(x)MAKE_LBL(54,x)
  4517.  
  4518. BEGIN("##atomic-set-car-if-eq?!")
  4519.  
  4520.     CMPW(    IMM(4),DTEMP1)
  4521.     BEQS(    passed_3args)
  4522.  
  4523.     WRONG_NB_ARGS(wrong_nb_arg1_trap,3,$entry)
  4524.  
  4525. LBL(passed_3args):
  4526.     movl    PVM0_REG,PVM4_REG
  4527.     movl    PVM1_REG,DTEMP1
  4528.     andw    IMM(-8),DTEMP1
  4529.     addql    IMM(4),DTEMP1
  4530.     movl    DTEMP1,ATEMP2
  4531.  
  4532.     LOCK_ATEMP2(lock)
  4533.  
  4534.     CMPL(    DTEMP1,PVM3_REG)
  4535.     BNES(    not_eq)
  4536.  
  4537.     movl    PVM2_REG,IND(ATEMP2)
  4538.     movl    IMM(SCM_true),PVM1_REG
  4539.     movl    PVM4_REG,PVM0_REG
  4540.     jmp    IND(PVM0_REG)
  4541.  
  4542. LBL(not_eq):
  4543.     movl    DTEMP1,IND(ATEMP2)
  4544.     movl    FALSE_REG,PVM1_REG
  4545.     movl    PVM4_REG,PVM0_REG
  4546.     jmp    IND(PVM0_REG)
  4547.  
  4548. CONSTS(0)
  4549. END
  4550.  
  4551. /*---------------------------------------------------------------------------*/
  4552.  
  4553. #undef LBL
  4554. #define LBL(x)MAKE_LBL(55,x)
  4555.  
  4556. BEGIN("##atomic-set-cdr-if-eq?!")
  4557.  
  4558.     CMPW(    IMM(4),DTEMP1)
  4559.     BEQS(    passed_3args)
  4560.  
  4561.     WRONG_NB_ARGS(wrong_nb_arg1_trap,3,$entry)
  4562.  
  4563. LBL(passed_3args):
  4564.     movl    PVM0_REG,PVM4_REG
  4565.     movl    PVM1_REG,DTEMP1
  4566.     andw    IMM(-8),DTEMP1
  4567.     movl    DTEMP1,ATEMP2
  4568.  
  4569.     LOCK_ATEMP2(lock)
  4570.  
  4571.     CMPL(    DTEMP1,PVM3_REG)
  4572.     BNES(    not_eq)
  4573.  
  4574.     movl    PVM2_REG,IND(ATEMP2)
  4575.     movl    IMM(SCM_true),PVM1_REG
  4576.     movl    PVM4_REG,PVM0_REG
  4577.     jmp    IND(PVM0_REG)
  4578.  
  4579. LBL(not_eq):
  4580.     movl    DTEMP1,IND(ATEMP2)
  4581.     movl    FALSE_REG,PVM1_REG
  4582.     movl    PVM4_REG,PVM0_REG
  4583.     jmp    IND(PVM0_REG)
  4584.  
  4585. CONSTS(0)
  4586. END
  4587.  
  4588. /*---------------------------------------------------------------------------*/
  4589.  
  4590. #undef LBL
  4591. #define LBL(x)MAKE_LBL(550,x)
  4592.  
  4593. BEGIN("##make-queue")
  4594.  
  4595.     CMPW(    IMM(1),DTEMP1)
  4596.     BEQS(    passed_0arg)
  4597.  
  4598.     WRONG_NB_ARGS(wrong_nb_arg1_trap,0,$entry)
  4599.  
  4600. LBL(passed_0arg):
  4601.  
  4602.     subql    IMM(4),HEAP_REG
  4603.     movl    NULL_REG,PDEC(HEAP_REG)
  4604.     movl    NULL_REG,PDEC(HEAP_REG)
  4605.     movl    IMM(QUEUE_SIZE*0x400+(SCM_subtype_QUEUE*8)),PDEC(HEAP_REG)
  4606.     lea    DISP(HEAP_REG,SCM_type_SUBTYPED),ATEMP1
  4607.     movl    ATEMP1,PVM1_REG
  4608.  
  4609. /* check heap overflow */
  4610.  
  4611.     CMPL(    DISP(PSTATE_REG,SLOT(HEAP_LIM)),HEAP_REG)
  4612.     BCCS(    ok)
  4613.     movl    PVM0_REG,PDEC(SP)
  4614.     TRAP(heap_alloc1_trap,alloc1,1,1)
  4615.     movl    PINC(SP),PVM0_REG
  4616. LBL(ok):
  4617.  
  4618.     jmp    IND(PVM0_REG)
  4619.  
  4620. CONSTS(0)
  4621. END
  4622.  
  4623. /*---------------------------------------------------------------------------*/
  4624.  
  4625. #undef LBL
  4626. #define LBL(x)MAKE_LBL(551,x)
  4627.  
  4628. BEGIN("##queue-peek-list")
  4629.  
  4630.     BMIS(    passed_1arg)
  4631.  
  4632.     WRONG_NB_ARGS(wrong_nb_arg1_trap,1,$entry)
  4633.  
  4634. LBL(passed_1arg):
  4635.  
  4636.     movl    PVM1_REG,ATEMP2
  4637.     movl    DISP(ATEMP2,SLOT(QUEUE_HEAD)+4-SCM_type_SUBTYPED),PVM1_REG
  4638.     jmp    IND(PVM0_REG)
  4639.  
  4640. CONSTS(0)
  4641. END
  4642.  
  4643. /*---------------------------------------------------------------------------*/
  4644.  
  4645. #undef LBL
  4646. #define LBL(x)MAKE_LBL(552,x)
  4647.  
  4648. BEGIN("##queue-get-list!")
  4649.  
  4650.     BMIS(    passed_1arg)
  4651.  
  4652.     WRONG_NB_ARGS(wrong_nb_arg1_trap,1,$entry)
  4653.  
  4654. LBL(passed_1arg):
  4655.  
  4656.     movl    PVM1_REG,ATEMP2
  4657.     lea    DISP(ATEMP2,SLOT(QUEUE_TAIL)+4-SCM_type_SUBTYPED),ATEMP2
  4658.  
  4659.     movl    PVM0_REG,PVM3_REG
  4660.     LOCK_ATEMP2(lock)
  4661.     movl    PVM3_REG,PVM0_REG
  4662.  
  4663.     CMPL(    DTEMP1,NULL_REG)
  4664.     BEQS(    empty)
  4665.  
  4666.     movl    DISP(ATEMP2,SLOT(QUEUE_HEAD-QUEUE_TAIL)),PVM1_REG
  4667.     movl    NULL_REG,DISP(ATEMP2,SLOT(QUEUE_HEAD-QUEUE_TAIL))
  4668.     movl    NULL_REG,IND(ATEMP2)
  4669.     jmp    IND(PVM0_REG)
  4670.  
  4671. LBL(empty):
  4672.     movl    NULL_REG,PVM1_REG
  4673.     movl    NULL_REG,IND(ATEMP2)
  4674.     jmp    IND(PVM0_REG)
  4675.  
  4676. CONSTS(0)
  4677. END
  4678.  
  4679. /*---------------------------------------------------------------------------*/
  4680.  
  4681. #undef LBL
  4682. #define LBL(x)MAKE_LBL(553,x)
  4683.  
  4684. BEGIN("##queue-get!")
  4685.  
  4686.     BMIS(    passed_1arg)
  4687.  
  4688.     WRONG_NB_ARGS(wrong_nb_arg1_trap,1,$entry)
  4689.  
  4690. LBL(passed_1arg):
  4691.  
  4692.     movl    PVM1_REG,ATEMP2
  4693.     lea    DISP(ATEMP2,SLOT(QUEUE_TAIL)+4-SCM_type_SUBTYPED),ATEMP2
  4694.  
  4695.     movl    PVM0_REG,PVM3_REG
  4696.     LOCK_ATEMP2(lock)
  4697.     movl    PVM3_REG,PVM0_REG
  4698.  
  4699.     CMPL(    DTEMP1,NULL_REG)
  4700.     BEQS(    empty1)
  4701.  
  4702.     movl    DISP(ATEMP2,SLOT(QUEUE_HEAD-QUEUE_TAIL)),PVM1_REG
  4703.     movl    PVM1_REG,ATEMP1
  4704.     movl    PDEC(ATEMP1),PVM4_REG
  4705.     movl    NULL_REG,IND(ATEMP1)
  4706.     movl    PVM4_REG,DISP(ATEMP2,SLOT(QUEUE_HEAD-QUEUE_TAIL))
  4707.     CMPL(    PVM4_REG,NULL_REG)
  4708.     BEQS(    empty2)
  4709.     movl    DTEMP1,IND(ATEMP2)
  4710.     jmp    IND(PVM0_REG)
  4711.  
  4712. LBL(empty1):
  4713.     movl    FALSE_REG,PVM1_REG
  4714. LBL(empty2):
  4715.     movl    NULL_REG,IND(ATEMP2)
  4716.     jmp    IND(PVM0_REG)
  4717.  
  4718. CONSTS(0)
  4719. END
  4720.  
  4721. /*---------------------------------------------------------------------------*/
  4722.  
  4723. #undef LBL
  4724. #define LBL(x)MAKE_LBL(554,x)
  4725.  
  4726. BEGIN("##queue-put!")
  4727.  
  4728.     BEQS(    passed_2args)
  4729.  
  4730.     WRONG_NB_ARGS(wrong_nb_arg1_trap,2,$entry)
  4731.  
  4732. LBL(passed_2args):
  4733.  
  4734.     movl    PVM2_REG,PDEC(HEAP_REG)
  4735.     movl    HEAP_REG,PVM2_REG
  4736.     movl    NULL_REG,PDEC(HEAP_REG)
  4737.  
  4738.     movl    PVM1_REG,ATEMP2
  4739.     lea    DISP(ATEMP2,SLOT(QUEUE_TAIL)+4-SCM_type_SUBTYPED),ATEMP2
  4740.  
  4741.     movl    PVM0_REG,PVM3_REG
  4742.     movl    PVM1_REG,PVM4_REG
  4743.     LOCK_ATEMP2(lock)
  4744.     movl    PVM4_REG,PVM1_REG
  4745.     movl    PVM3_REG,PVM0_REG
  4746.  
  4747.     CMPL(    DTEMP1,NULL_REG)
  4748.     BEQS(    empty)
  4749.  
  4750.     movl    DTEMP1,ATEMP1
  4751.     movl    PVM2_REG,PDEC(ATEMP1)
  4752.     BRAS(    unlock)
  4753.  
  4754. LBL(empty):
  4755.     movl    PVM2_REG,DISP(ATEMP2,SLOT(QUEUE_HEAD-QUEUE_TAIL))
  4756.  
  4757. LBL(unlock):
  4758.     movl    PVM2_REG,IND(ATEMP2)
  4759.  
  4760. /* check heap overflow */
  4761.  
  4762.     CMPL(    DISP(PSTATE_REG,SLOT(HEAP_LIM)),HEAP_REG)
  4763.     BCCS(    ok)
  4764.     movl    PVM0_REG,PDEC(SP)
  4765.     TRAP(heap_alloc1_trap,alloc1,1,1)
  4766.     movl    PINC(SP),PVM0_REG
  4767. LBL(ok):
  4768.  
  4769.     jmp    IND(PVM0_REG)
  4770.  
  4771. CONSTS(0)
  4772. END
  4773.  
  4774. /*---------------------------------------------------------------------------*/
  4775.  
  4776. #undef LBL
  4777. #define LBL(x)MAKE_LBL(56,x)
  4778.  
  4779. BEGIN("##make-semaphore")
  4780.  
  4781.     CMPW(    IMM(1),DTEMP1)
  4782.     BEQS(    passed_0arg)
  4783.  
  4784.     WRONG_NB_ARGS(wrong_nb_arg1_trap,0,$entry)
  4785.  
  4786. LBL(passed_0arg):
  4787.  
  4788.     movl    IMM(1*8),PDEC(HEAP_REG)
  4789.     movl    NULL_REG,PDEC(HEAP_REG)
  4790.     movl    NULL_REG,PDEC(HEAP_REG)
  4791.     movl    IMM(SEMAPHORE_SIZE*0x400+(SCM_subtype_SEMAPHORE*8)),PDEC(HEAP_REG)
  4792.     lea    DISP(HEAP_REG,SCM_type_SUBTYPED),ATEMP1
  4793.     movl    ATEMP1,PVM1_REG
  4794.  
  4795. /* check heap overflow */
  4796.  
  4797.     CMPL(    DISP(PSTATE_REG,SLOT(HEAP_LIM)),HEAP_REG)
  4798.     BCCS(    ok)
  4799.     movl    PVM0_REG,PDEC(SP)
  4800.     TRAP(heap_alloc1_trap,alloc1,1,1)
  4801.     movl    PINC(SP),PVM0_REG
  4802. LBL(ok):
  4803.  
  4804.     jmp    IND(PVM0_REG)
  4805.  
  4806. CONSTS(0)
  4807. END
  4808.  
  4809. /*---------------------------------------------------------------------------*/
  4810.  
  4811. #undef LBL
  4812. #define LBL(x)MAKE_LBL(57,x)
  4813.  
  4814. BEGIN("##semaphore-wait")
  4815.  
  4816.     BMIS(    passed_1arg)
  4817.  
  4818.     WRONG_NB_ARGS(wrong_nb_arg1_trap,1,$entry)
  4819.  
  4820. LBL(passed_1arg):
  4821.  
  4822.     movl    PVM1_REG,PVM4_REG
  4823.  
  4824.     movl    PVM4_REG,ATEMP2
  4825.     lea    DISP(ATEMP2,SLOT(SEMAPHORE_COUNT)+4-SCM_type_SUBTYPED),ATEMP2
  4826.  
  4827.     movl    PVM0_REG,PVM3_REG
  4828.     LOCK_ATEMP2(lock1)
  4829.     movl    PVM3_REG,PVM0_REG
  4830.  
  4831.     clrl    IND(ATEMP2)        /* semaphore count now 0 */
  4832.  
  4833.     tstl    DTEMP1            /* semaphore count was 0? */
  4834.     BEQS(    count_was_0)
  4835.  
  4836.     movl    FALSE_REG,PVM1_REG
  4837.     jmp    IND(PVM0_REG)
  4838.  
  4839. LBL(count_was_0):
  4840.  
  4841. /* suspend task on semaphore */
  4842.  
  4843.     movl    PVM0_REG,PDEC(SP)
  4844.  
  4845. /* Call ###_kernel.transfer-lazy-tasks-to-heap. */
  4846.  
  4847.     pea    PC_IND(ret1)
  4848.     movl    CONST(0),ATEMP1
  4849.     jmp    IND(ATEMP1)
  4850. RETURN(ret1,1,1):
  4851.  
  4852. /* Call ###_kernel.transfer-stack-to-heap. */
  4853.  
  4854. /* ###_kernel.transfer-lazy-tasks-to-heap has reserved enough */
  4855. /* space, so no GC check required.                            */
  4856.  
  4857.     pea    PC_IND(ret2)
  4858.     movl    CONST(1),ATEMP1
  4859.     jmp    IND(ATEMP1)
  4860. LBL(ret2):
  4861.  
  4862. /* Save state of current task. */
  4863.  
  4864.     movl    DISP(PSTATE_REG,SLOT(CURRENT_TASK)),ATEMP1
  4865.  
  4866.     movl    PINC(SP),PVM0_REG
  4867.     movl    PVM0_REG,DISP(ATEMP1,SLOT(TASK_CONT_RET)+4-SCM_type_SUBTYPED)
  4868.     movl    PVM2_REG,DISP(ATEMP1,SLOT(TASK_CONT_FRAME)+4-SCM_type_SUBTYPED)
  4869.     movl    DISP(PSTATE_REG,SLOT(CURRENT_DYN_ENV)),DISP(ATEMP1,SLOT(TASK_CONT_DYN_ENV)+4-SCM_type_SUBTYPED)
  4870.     movl    FALSE_REG,DISP(ATEMP1,SLOT(TASK_VALUE)+4-SCM_type_SUBTYPED)
  4871.  
  4872.     movl    ATEMP1,PDEC(HEAP_REG)
  4873.     movl    HEAP_REG,PVM3_REG
  4874.     movl    NULL_REG,PDEC(HEAP_REG)
  4875.  
  4876. /* Final check for availability. */
  4877.  
  4878.     movl    PVM4_REG,ATEMP2
  4879.     lea    DISP(ATEMP2,SLOT(SEMAPHORE_COUNT)+4-SCM_type_SUBTYPED),ATEMP2
  4880.  
  4881.     LOCK_ATEMP2(lock2)
  4882.  
  4883.     tstl    DTEMP1            /* semaphore count was 0? */
  4884.     BEQS(    semaphore_still_not_free)
  4885.  
  4886.     clrl    IND(ATEMP2)        /* semaphore count now 0 */
  4887.  
  4888.     addql    IMM(8),HEAP_REG        /* discard cons cell */
  4889.  
  4890. /* Resume task. */
  4891.  
  4892.     movl    DISP(PSTATE_REG,SLOT(CURRENT_TASK)),ATEMP2
  4893.     movl    DISP(ATEMP2,SLOT(TASK_CONT_RET)+4-SCM_type_SUBTYPED),DISP(PSTATE_REG,SLOT(PARENT_RET))
  4894.     movl    DISP(ATEMP2,SLOT(TASK_CONT_FRAME)+4-SCM_type_SUBTYPED),DISP(PSTATE_REG,SLOT(PARENT_FRAME))
  4895.     movl    DISP(ATEMP2,SLOT(TASK_CONT_DYN_ENV)+4-SCM_type_SUBTYPED),DISP(PSTATE_REG,SLOT(CURRENT_DYN_ENV))
  4896.  
  4897.     movl    PVM4_REG,PVM0_REG
  4898.     movl    PVM4_REG,PVM1_REG
  4899.     movl    PVM4_REG,PVM2_REG
  4900.     movl    PVM4_REG,PVM3_REG
  4901.  
  4902.     movl    DISP(PSTATE_REG,SLOT(BOS_RET)),ATEMP1
  4903.     jmp    IND(ATEMP1)
  4904.  
  4905. LBL(semaphore_still_not_free):
  4906.  
  4907. #ifndef butterfly
  4908.  
  4909.     CMPL(    DISP(PSTATE_REG,SLOT(WORKQ_TAIL)),NULL_REG)    /* anything else runnable? */
  4910.     BNES(    no_deadlock)
  4911.  
  4912. /* Resume task. */
  4913.  
  4914.     movl    DISP(PSTATE_REG,SLOT(CURRENT_TASK)),ATEMP2
  4915.     movl    DISP(ATEMP2,SLOT(TASK_CONT_RET)+4-SCM_type_SUBTYPED),DISP(PSTATE_REG,SLOT(PARENT_RET))
  4916.     movl    DISP(ATEMP2,SLOT(TASK_CONT_FRAME)+4-SCM_type_SUBTYPED),DISP(PSTATE_REG,SLOT(PARENT_FRAME))
  4917.     movl    DISP(ATEMP2,SLOT(TASK_CONT_DYN_ENV)+4-SCM_type_SUBTYPED),DISP(PSTATE_REG,SLOT(CURRENT_DYN_ENV))
  4918.  
  4919.     movl    PVM4_REG,PVM0_REG
  4920.     movl    PVM4_REG,PVM1_REG
  4921.     movl    PVM4_REG,PVM2_REG
  4922.     movl    PVM4_REG,PVM3_REG
  4923.  
  4924.     movl    DISP(PSTATE_REG,SLOT(BOS_RET)),PVM0_REG
  4925.     movl    CONST(3),ATEMP1    /* jump to ##exception.deadlock */
  4926.     moveq    IMM(1),DTEMP1    /* passing 0 argument */
  4927.     jmp    IND(ATEMP1)
  4928.  
  4929. LBL(no_deadlock):
  4930.  
  4931. #endif
  4932.  
  4933. /* add task to tail of waiting queue */
  4934.  
  4935.     movl    DISP(ATEMP2,SLOT(SEMAPHORE_TAIL-SEMAPHORE_COUNT)),DTEMP1
  4936.     CMPL(    DTEMP1,NULL_REG)
  4937.     BEQS(    empty)
  4938.     movl    DTEMP1,ATEMP1
  4939.     movl    PVM3_REG,PDEC(ATEMP1)
  4940.     BRAS(    done)
  4941. LBL(empty):
  4942.     movl    PVM3_REG,DISP(ATEMP2,SLOT(SEMAPHORE_HEAD-SEMAPHORE_COUNT))
  4943. LBL(done):
  4944.     movl    PVM3_REG,DISP(ATEMP2,SLOT(SEMAPHORE_TAIL-SEMAPHORE_COUNT))
  4945.  
  4946.     clrl    IND(ATEMP2)        /* semaphore count now 0 */
  4947.  
  4948. #ifdef MAINTAIN_TASK_STATUS
  4949.  
  4950. /* Change task's status to WAITING */
  4951.  
  4952.     movl    DISP(PSTATE_REG,SLOT(CURRENT_TASK)),ATEMP1
  4953.     movl    NULL_REG,DISP(ATEMP1,SLOT(TASK_STATUS)+4-SCM_type_SUBTYPED)
  4954.  
  4955. #endif
  4956.  
  4957.     moveq    IMM(0),PVM1_REG
  4958.     movl    CONST(2),ATEMP1
  4959.     jmp    IND(ATEMP1)
  4960.  
  4961. CONSTS(4)
  4962. PRIMITIVE("###_kernel.transfer-lazy-tasks-to-heap")
  4963. PRIMITIVE("###_kernel.transfer-stack-to-heap")
  4964. PRIMITIVE("###_kernel.idle")
  4965. PRIMITIVE("##exception.deadlock")
  4966. END
  4967.  
  4968. /*---------------------------------------------------------------------------*/
  4969.  
  4970. #undef LBL
  4971. #define LBL(x)MAKE_LBL(58,x)
  4972.  
  4973. BEGIN("##semaphore-signal")
  4974.  
  4975.     BMIS(    passed_1arg)
  4976.  
  4977.     WRONG_NB_ARGS(wrong_nb_arg1_trap,1,$entry)
  4978.  
  4979. LBL(passed_1arg):
  4980.  
  4981.     movl    PVM1_REG,PVM4_REG
  4982.  
  4983.     movl    PVM4_REG,ATEMP2
  4984.     lea    DISP(ATEMP2,SLOT(SEMAPHORE_COUNT)+4-SCM_type_SUBTYPED),ATEMP2
  4985.  
  4986.     movl    PVM0_REG,PVM3_REG
  4987.     LOCK_ATEMP2(lock1)
  4988.     movl    PVM3_REG,PVM0_REG
  4989.  
  4990.     movl    DISP(ATEMP2,SLOT(SEMAPHORE_TAIL-SEMAPHORE_COUNT)),DTEMP1
  4991.     CMPL(    DTEMP1,NULL_REG)
  4992.     BNES(    restart_task)
  4993.  
  4994.     movl    IMM(1*8),IND(ATEMP2)    /* semaphore count now 1 */
  4995.  
  4996.     movl    FALSE_REG,PVM1_REG
  4997.     jmp    IND(PVM0_REG)
  4998.  
  4999. LBL(restart_task):
  5000.  
  5001. /* remove first task from waiting queue */
  5002.  
  5003.     movl    DISP(ATEMP2,SLOT(SEMAPHORE_HEAD-SEMAPHORE_COUNT)),ATEMP1
  5004.     movl    DISP(ATEMP1,SLOT(-1)),PVM1_REG
  5005.     movl    PVM1_REG,DISP(ATEMP2,SLOT(SEMAPHORE_HEAD-SEMAPHORE_COUNT))
  5006.     CMPL(    PVM1_REG,NULL_REG)
  5007.     BNES(    done)
  5008.     movl    NULL_REG,DISP(ATEMP2,SLOT(SEMAPHORE_TAIL-SEMAPHORE_COUNT))
  5009. LBL(done):
  5010.  
  5011.     clrl    IND(ATEMP2)        /* semaphore count now 0 */
  5012.  
  5013. #ifdef MAINTAIN_TASK_STATUS
  5014.  
  5015. /* Change task's status to READY */
  5016.  
  5017.     movl    IND(ATEMP1),ATEMP2
  5018.     movl    ATEMP1,DISP(ATEMP2,SLOT(TASK_STATUS)+4-SCM_type_SUBTYPED)
  5019.  
  5020. #endif
  5021.  
  5022. /* add task to work queue */
  5023.  
  5024.     movl    FALSE_REG,DISP(PSTATE_REG,SLOT(WORKQ_LOCKO))
  5025. LBL(lock_workq):
  5026.     tstl    DISP(PSTATE_REG,SLOT(WORKQ_LOCKV))
  5027.     BNES(    lock_workq)
  5028.  
  5029.     movl    DISP(PSTATE_REG,SLOT(WORKQ_TAIL)),ATEMP2
  5030.     CMPL(    ATEMP2,NULL_REG)
  5031.     BNES(    non_empty_queue)
  5032.     movl    ATEMP1,DISP(PSTATE_REG,SLOT(WORKQ_HEAD))
  5033.     BRAS(    fix_tail)
  5034. LBL(non_empty_queue):
  5035.     movl    ATEMP1,PDEC(ATEMP2)
  5036.  
  5037. LBL(fix_tail):
  5038.     movl    ATEMP1,DISP(PSTATE_REG,SLOT(WORKQ_TAIL))
  5039.  
  5040.     movl    NULL_REG,PDEC(ATEMP1)
  5041.  
  5042.     clrl    DISP(PSTATE_REG,SLOT(WORKQ_LOCKO))
  5043.  
  5044. /* return */
  5045.  
  5046.     movl    FALSE_REG,PVM1_REG
  5047.     jmp    IND(PVM0_REG)
  5048.  
  5049. CONSTS(0)
  5050. END
  5051.  
  5052. /*---------------------------------------------------------------------------*/
  5053.  
  5054. #undef LBL
  5055. #define LBL(x)MAKE_LBL(59,x)
  5056.  
  5057. BEGIN("##legitimacy-barrier")
  5058.  
  5059.     CMPW(    IMM(1),DTEMP1)
  5060.     BEQS(    passed_0arg)
  5061.  
  5062.     WRONG_NB_ARGS(wrong_nb_arg1_trap,0,$entry)
  5063.  
  5064. LBL(passed_0arg):
  5065.     movl    DISP(PSTATE_REG,SLOT(CURRENT_TASK)),ATEMP1
  5066.     movl    DISP(ATEMP1,SLOT(TASK_LEGIT)+4-SCM_type_SUBTYPED),PVM1_REG
  5067.  
  5068. /* touch legitimacy placeholder */
  5069.  
  5070.     btst    PVM1_REG,PLACEHOLDER_REG
  5071.     BEQS(    touch)
  5072.     jmp    IND(PVM0_REG)
  5073.  
  5074. LBL(touch):
  5075.     movl    PVM1_REG,ATEMP2
  5076.     movl    DISP(ATEMP2,SLOT(PH_VALUE)-SCM_type_PLACEHOLDER),PVM1_REG
  5077.     CMPL(    ATEMP2,PVM1_REG)
  5078.     BNES(    determined)
  5079.  
  5080.     LOG(EVENT_TOUCH_UNDET,log1)
  5081.  
  5082. /* legitimacy placeholders can be determined to placeholders, so must chase */
  5083.  
  5084.     movl    PVM0_REG,PDEC(SP)
  5085.     lea    PC_IND(ret),PVM0_REG
  5086.     movl    CONST(0),ATEMP1
  5087.     jmp    IND(ATEMP1)    /* jump to ###_kernel.touch */
  5088. RETURN(ret,1,1):
  5089.     movl    PINC(SP),PVM0_REG
  5090. LBL(determined):
  5091.     btst    PVM1_REG,PLACEHOLDER_REG
  5092.     BEQS(    touch)
  5093.  
  5094.     jmp    IND(PVM0_REG)
  5095.  
  5096. CONSTS(1)
  5097. PRIMITIVE("###_kernel.touch")
  5098. END
  5099.  
  5100. /*---------------------------------------------------------------------------*/
  5101.  
  5102. #undef LBL
  5103. #define LBL(x)MAKE_LBL(60,x)
  5104.  
  5105. BEGIN("##sequentially")
  5106.  
  5107.     BMIS(    passed_1arg)
  5108.  
  5109.     WRONG_NB_ARGS(wrong_nb_arg1_trap,1,$entry)
  5110.  
  5111. LBL(passed_1arg):
  5112.  
  5113.     movl    PVM0_REG,PDEC(SP)
  5114.  
  5115. /* Call ###_kernel.transfer-lazy-tasks-to-heap. */
  5116.  
  5117.     CMPL(    DISP(PSTATE_REG,SLOT(LTQ_HEAD)),LTQ_TAIL_REG)
  5118.     BEQS(    tasks_transferred)
  5119.  
  5120.     movl    PVM1_REG,PDEC(SP)
  5121.     pea    PC_IND(ret1)
  5122.     movl    CONST(0),ATEMP1
  5123.     jmp    IND(ATEMP1)
  5124. RETURN(ret1,2,1):
  5125.     movl    PINC(SP),PVM1_REG
  5126.     moveq    IMM(0),PVM3_REG
  5127.  
  5128. LBL(tasks_transferred):
  5129.  
  5130.     movl    PVM1_REG,ATEMP2
  5131.  
  5132. /* Remove tasks from workq */
  5133.  
  5134.     movl    FALSE_REG,DISP(PSTATE_REG,SLOT(WORKQ_LOCKO))
  5135. LBL(lock_workq1):
  5136.     tstl    DISP(PSTATE_REG,SLOT(WORKQ_LOCKV))
  5137.     BNES(    lock_workq1)
  5138.  
  5139.     movl    DISP(PSTATE_REG,SLOT(WORKQ_HEAD)),PDEC(SP)
  5140.  
  5141.     movl    NULL_REG,DISP(PSTATE_REG,SLOT(WORKQ_HEAD))
  5142.     movl    NULL_REG,DISP(PSTATE_REG,SLOT(WORKQ_TAIL))
  5143.  
  5144.     clrl    DISP(PSTATE_REG,SLOT(WORKQ_LOCKO))
  5145.  
  5146. /* Call procedure */
  5147.  
  5148.     lea    PC_IND(ret2),PVM0_REG
  5149.     moveq    IMM(1),DTEMP1
  5150.     jmp    IND(ATEMP2)
  5151.  
  5152. RETURN(ret2,2,1):
  5153.  
  5154. /* Restore tasks to workq */
  5155.  
  5156.     movl    PINC(SP),PVM2_REG
  5157.  
  5158.     btst    PVM2_REG,PAIR_REG    /* pair? */
  5159.     BNES(    done)
  5160.  
  5161.     movl    PVM2_REG,DTEMP1        /* get tail */
  5162. LBL(loop):
  5163.     movl    DTEMP1,ATEMP2
  5164.     movl    PDEC(ATEMP2),DTEMP1
  5165.     btst    DTEMP1,PAIR_REG
  5166.     BEQS(    loop)
  5167.  
  5168.     movl    FALSE_REG,DISP(PSTATE_REG,SLOT(WORKQ_LOCKO))
  5169. LBL(lock_workq2):
  5170.     tstl    DISP(PSTATE_REG,SLOT(WORKQ_LOCKV))
  5171.     BNES(    lock_workq2)
  5172.  
  5173.     CMPL(    DISP(PSTATE_REG,SLOT(WORKQ_TAIL)),NULL_REG)
  5174.     BNES(    non_empty_queue)
  5175.     movl    NULL_REG,PINC(ATEMP2)
  5176.     movl    ATEMP2,DISP(PSTATE_REG,SLOT(WORKQ_TAIL))
  5177.     BRAS(    fix_head)
  5178. LBL(non_empty_queue):
  5179.     movl    DISP(PSTATE_REG,SLOT(WORKQ_HEAD)),PINC(ATEMP2)
  5180. LBL(fix_head):
  5181.     movl    PVM2_REG,DISP(PSTATE_REG,SLOT(WORKQ_HEAD))
  5182.  
  5183.     clrl    DISP(PSTATE_REG,SLOT(WORKQ_LOCKO))
  5184.  
  5185. LBL(done):
  5186.     rts
  5187.  
  5188. CONSTS(1)
  5189. PRIMITIVE("###_kernel.transfer-lazy-tasks-to-heap")
  5190. END
  5191.  
  5192. /*---------------------------------------------------------------------------*/
  5193.  
  5194. #undef LBL
  5195. #define LBL(x)MAKE_LBL(61,x)
  5196.  
  5197. BEGIN("###_kernel.startup")
  5198.  
  5199. /*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
  5200.  
  5201. /* Save C's context: */
  5202.  
  5203.     movl    CONST(0),REG(a1)
  5204. #ifndef MIN_C_CONTEXT
  5205.     movl    REG(d2),DISP(REG(a1),C_D2)
  5206.     movl    REG(d3),DISP(REG(a1),C_D3)
  5207.     movl    REG(d4),DISP(REG(a1),C_D4)
  5208.     movl    REG(d5),DISP(REG(a1),C_D5)
  5209.     movl    REG(d6),DISP(REG(a1),C_D6)
  5210.     movl    REG(d7),DISP(REG(a1),C_D7)
  5211.     movl    REG(a2),DISP(REG(a1),C_A2)
  5212.     movl    REG(a3),DISP(REG(a1),C_A3)
  5213.     movl    REG(a4),DISP(REG(a1),C_A4)
  5214. #endif
  5215.     movl    REG(a5),DISP(REG(a1),C_A5)
  5216.     movl    REG(a6),DISP(REG(a1),C_A6)
  5217.     movl    SP,DISP(REG(a1),C_SP)
  5218.  
  5219. /*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
  5220.  
  5221. /* Get parameters: */
  5222.  
  5223.     movl    DISP(SP,4),TABLE_REG    /* always = ptr to glob/code table */
  5224.     movl    DISP(SP,8),PSTATE_REG    /* always = ptr to processor state */
  5225.  
  5226.     movl    DISP(SP,12),DTEMP1    /* init 68881 coprocessor */
  5227.     BEQS(    no_68881)
  5228.     fmovel    IMM(0),FPSR
  5229.     fmovel    IMM(0),FPCR
  5230. LBL(no_68881):
  5231.  
  5232. /*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
  5233.  
  5234. /* Setup registers: */
  5235.  
  5236.     moveq    IMM(0),INTR_TIMER_REG
  5237.  
  5238.     movl    IMM(SCM_null),NULL_REG
  5239.     movl    IMM(SCM_false),FALSE_REG
  5240.  
  5241.     movl    DISP(PSTATE_REG,SLOT(HEAP_PTR)),HEAP_REG
  5242.  
  5243. /*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
  5244.  
  5245. /* Setup stack structure: */
  5246.  
  5247.     movl    DISP(PSTATE_REG,SLOT(STACK_BOT)),DTEMP1
  5248.     addl    IMM(SLOT(STACK_ALLOCATION_FUDGE)),DTEMP1
  5249.     addl    DISP(PSTATE_REG,SLOT(STACK_MARGIN)),DTEMP1
  5250.     movl    DTEMP1,DISP(PSTATE_REG,SLOT(STACK_LIM))
  5251.  
  5252.     movl    IMM(-1),DISP(PSTATE_REG,SLOT(INTR_FLAG))
  5253.  
  5254.     movl    DISP(PSTATE_REG,SLOT(STACK_PTR)),SP
  5255.     movl    DISP(PSTATE_REG,SLOT(LTQ_TAIL)),LTQ_TAIL_REG
  5256.  
  5257. /*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
  5258.  
  5259. /* Setup 'bottom of stack' return address: */
  5260.  
  5261.     lea    PC_IND(bos_ret),PVM0_REG
  5262.     movl    PVM0_REG,DISP(PSTATE_REG,SLOT(BOS_RET))
  5263.  
  5264. /*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
  5265.  
  5266. /* Start processors: */
  5267.  
  5268.     MAKE_TEMP_TASK
  5269.  
  5270.     movl    DISP(PSTATE_REG,SLOT(ID)),DTEMP1
  5271.     BEQS(    processor0)
  5272.  
  5273. /*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
  5274.  
  5275. /* Startup other processors: */
  5276.  
  5277.     moveq    IMM(0),PVM1_REG
  5278.     movl    CONST(1),ATEMP1
  5279.     jmp    IND(ATEMP1)
  5280.  
  5281. /*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
  5282.  
  5283. /* Startup processor 0: */
  5284.  
  5285. LBL(processor0):
  5286.  
  5287. /* Make root task. */
  5288.  
  5289.     clrl    PDEC(HEAP_REG)
  5290.     clrl    PDEC(HEAP_REG)
  5291.     movl    PSTATE_REG,PDEC(HEAP_REG)
  5292.     clrl    PDEC(HEAP_REG)
  5293.     clrl    PDEC(HEAP_REG)
  5294.     movl    IMM(SCM_true),PDEC(HEAP_REG)
  5295.     clrl    PDEC(HEAP_REG)
  5296.     clrl    PDEC(HEAP_REG)
  5297.     clrl    PDEC(HEAP_REG)
  5298.     movl    IMM(TASK_SIZE*0x400+(SCM_subtype_TASK*8)),PDEC(HEAP_REG)
  5299.     lea    DISP(HEAP_REG,SCM_type_SUBTYPED),ATEMP1
  5300.  
  5301.     movl    ATEMP1,DISP(PSTATE_REG,SLOT(CURRENT_TASK))
  5302.  
  5303. /* Make root continuation. */
  5304.  
  5305.     subql    IMM(4),HEAP_REG
  5306.     movl    FALSE_REG,PDEC(HEAP_REG)
  5307.     movl    FALSE_REG,PDEC(HEAP_REG)
  5308.     movl    IMM(2*0x400+SCM_subtype_FRAME*8),PDEC(HEAP_REG)
  5309.     lea    DISP(HEAP_REG,SCM_type_SUBTYPED),ATEMP2
  5310.  
  5311.     lea    PC_IND(root_continuation),ATEMP1
  5312.     movl    ATEMP1,DISP(PSTATE_REG,SLOT(PARENT_RET))
  5313.     movl    ATEMP2,DISP(PSTATE_REG,SLOT(PARENT_FRAME))
  5314.     movl    NULL_REG,DISP(PSTATE_REG,SLOT(CURRENT_DYN_ENV))
  5315.     movl    DISP(PSTATE_REG,SLOT(BOS_RET)),PVM0_REG
  5316.  
  5317. #ifdef debug
  5318. /*****/    pea    PC_IND($entry)
  5319. /*****/    movl    PINC(SP),DISP(PSTATE_REG,SLOT(56))
  5320. /*****/    movl    DISP(PSTATE_REG,SLOT(BOS_RET)),DISP(PSTATE_REG,SLOT(57))
  5321. /*****/    movl    IMM(0),DISP(PSTATE_REG,SLOT(58))
  5322. #endif
  5323.  
  5324. /* Clear PVM registers. */
  5325.  
  5326.     moveq    IMM(0),PVM1_REG
  5327.     movl    PVM1_REG,PVM2_REG
  5328.     movl    PVM1_REG,PVM3_REG
  5329.     movl    PVM1_REG,PVM4_REG
  5330.  
  5331.     LOG(EVENT_WORKING,log1)
  5332.  
  5333.     movl    CONST(2),ATEMP1        /* jump to ##STARTUP proc */
  5334.     moveq    IMM(1),DTEMP1        /* passing 0 argument */
  5335.     jmp    IND(ATEMP1)
  5336.  
  5337. RETURN(root_continuation,1,1):
  5338.     movl    CONST(0),REG(a1)        /* restore C's registers */
  5339. #ifndef MIN_C_CONTEXT
  5340.     movl    DISP(REG(a1),C_D2),REG(d2)
  5341.     movl    DISP(REG(a1),C_D3),REG(d3)
  5342.     movl    DISP(REG(a1),C_D4),REG(d4)
  5343.     movl    DISP(REG(a1),C_D5),REG(d5)
  5344.     movl    DISP(REG(a1),C_D6),REG(d6)
  5345.     movl    DISP(REG(a1),C_D7),REG(d7)
  5346.     movl    DISP(REG(a1),C_A2),REG(a2)
  5347.     movl    DISP(REG(a1),C_A3),REG(a3)
  5348.     movl    DISP(REG(a1),C_A4),REG(a4)
  5349. #endif
  5350.     movl    DISP(REG(a1),C_A5),REG(a5)
  5351.     movl    DISP(REG(a1),C_A6),REG(a6)
  5352.     movl    DISP(REG(a1),C_SP),SP
  5353.  
  5354.     rts
  5355.  
  5356. /*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
  5357.  
  5358. RETURN(bos_ret,0,0):
  5359. /* A fs of 0 is a special return point marker.  Here it indicates the return */
  5360. /* point in the oldest frame in the stack. */
  5361.  
  5362.     movl    PVM0_REG,DISP(PSTATE_REG,SLOT(TEMP1))
  5363.     movl    PVM1_REG,DISP(PSTATE_REG,SLOT(TEMP2))
  5364.  
  5365. #ifndef MESSAGE_PASSING_STEAL
  5366.  
  5367.     movl    FALSE_REG,DISP(PSTATE_REG,SLOT(STEAL_LOCKO))
  5368. LBL(lock_steal):
  5369.     tstl    DISP(PSTATE_REG,SLOT(STEAL_LOCKV))
  5370.     BNES(    lock_steal)
  5371.     movl    DISP(PSTATE_REG,SLOT(LTQ_HEAD)),LTQ_TAIL_REG
  5372.     movl    DISP(PSTATE_REG,SLOT(Q_BOT)),ATEMP1
  5373. LBL(loop1):
  5374.     clrl    PDEC(LTQ_TAIL_REG)
  5375.     CMPL(    ATEMP1,LTQ_TAIL_REG)
  5376.     BNES(    loop1)
  5377. #endif
  5378.  
  5379.     RESET_STACK
  5380.  
  5381. /* After RESET_STACK, ATEMP1 = DEQ_TAIL */
  5382.  
  5383. #ifdef debug
  5384. /*****/    movl    DISP(PSTATE_REG,SLOT(PARENT_FRAME)),PDEC(SP)
  5385. /*****/    movl    DISP(PSTATE_REG,SLOT(PARENT_RET)),PDEC(SP)
  5386. /*****/    movl    DISP(PSTATE_REG,SLOT(56)),PDEC(SP)
  5387. /*****/    movl    DISP(PSTATE_REG,SLOT(57)),PDEC(SP)
  5388. /*****/    movl    DISP(PSTATE_REG,SLOT(58)),PDEC(SP)
  5389. #endif
  5390.  
  5391.     movl    DISP(PSTATE_REG,SLOT(PARENT_FRAME)),PVM0_REG
  5392.  
  5393.     subql    IMM(SCM_type_SUBTYPED),PVM0_REG
  5394.     movl    PINC(PVM0_REG),PVM1_REG
  5395.     lsrl    IMM(8),PVM1_REG
  5396.  
  5397. LBL(wait):
  5398.     movl    PINC(PVM0_REG),DISP(PSTATE_REG,SLOT(PARENT_FRAME))
  5399.     BNES(    copy_frame)
  5400.     subql    IMM(4),PVM0_REG
  5401.     BRAS(    wait)
  5402. LBL(copy_frame):
  5403.  
  5404. /* copy frame */
  5405.  
  5406. #ifdef RESTORE_PARENT_USING_BTRANSFER
  5407.  
  5408. broken...
  5409.  
  5410.     subql    IMM(4),PVM1_REG        /* PVM1_REG = length of frame */
  5411.     subl    PVM1_REG,SP        /* allocate space on stack */
  5412.     movl    SP,DTEMP1
  5413.     BTRANSFER(copy)
  5414.  
  5415. #else
  5416.  
  5417. #ifdef debug
  5418. /*****/    addw    IMM(5*4),SP
  5419. #endif
  5420.  
  5421.     movl    SP,DTEMP1
  5422.     subql    IMM(4),PVM1_REG        /* PVM1_REG = length of frame */
  5423.     subl    PVM1_REG,SP        /* allocate space on stack */
  5424.     movl    SP,ATEMP2
  5425.  
  5426.     lsrl    IMM(2),PVM1_REG
  5427.     subql    IMM(1),PVM1_REG
  5428. LBL(loop3):
  5429.     movl    PINC(PVM0_REG),PINC(ATEMP2)
  5430.     DBRA(    PVM1_REG,loop3)
  5431.  
  5432. #endif
  5433.  
  5434. /* Scan each frame of continuation... */
  5435.  
  5436.     movl    DISP(PSTATE_REG,SLOT(PARENT_RET)),PVM0_REG
  5437.     movl    SP,PVM1_REG
  5438.  
  5439. #ifdef debug
  5440. /*****/    movl    DISP(PSTATE_REG,SLOT(PARENT_FRAME)),PDEC(SP)
  5441. /*****/    movl    DISP(PSTATE_REG,SLOT(PARENT_RET)),PDEC(SP)
  5442. /*****/    movl    DISP(PSTATE_REG,SLOT(56)),PDEC(SP)
  5443. /*****/    movl    DISP(PSTATE_REG,SLOT(57)),PDEC(SP)
  5444. /*****/    movl    DISP(PSTATE_REG,SLOT(58)),PDEC(SP)
  5445. #endif
  5446.  
  5447.  
  5448. LBL(loop4):
  5449.     movl    PVM1_REG,ATEMP2
  5450.     moveq    IMM(0),PVM1_REG
  5451.     movw    DISP(PVM0_REG,-6),PVM1_REG    /* get fs */
  5452.     BGTS(    normal_ret)
  5453.     BEQS(    dyn_env_ret)
  5454.     movl    ATEMP2,PINC(LTQ_TAIL_REG)    /* push task marker */
  5455.     andw    IMM(0x7fff),PVM1_REG
  5456.     BRAS(    normal_ret)
  5457. LBL(dyn_env_ret):
  5458.     movl    ATEMP2,PDEC(ATEMP1)        /* push dyn env marker */
  5459.     movw    IMM(SLOT(DYN_ENV_FS)),PVM1_REG
  5460. LBL(normal_ret):
  5461.     addl    ATEMP2,PVM1_REG
  5462.     addw    DISP(PVM0_REG,-4),ATEMP2    /* add link */
  5463.     movl    IND(ATEMP2),PVM0_REG
  5464.     CMPL(    DTEMP1,PVM1_REG)
  5465.     BNES(    loop4)
  5466.  
  5467.     movl    DISP(PSTATE_REG,SLOT(BOS_RET)),IND(ATEMP2)
  5468.  
  5469. /* Slots of LTQ and DEQ are in reverse order, so reverse them... */
  5470.  
  5471.     movl    ATEMP1,DISP(PSTATE_REG,SLOT(DEQ_TAIL))
  5472.     movl    DISP(PSTATE_REG,SLOT(DEQ_HEAD)),ATEMP2
  5473. LBL(loop5):
  5474.     movl    PDEC(ATEMP2),DTEMP1
  5475.     CMPL(    ATEMP2,ATEMP1)
  5476.     BCCS(    deq_reversed)
  5477.     movl    IND(ATEMP1),IND(ATEMP2)
  5478.     movl    DTEMP1,PINC(ATEMP1)
  5479.     BRAS(    loop5)
  5480. LBL(deq_reversed):
  5481.  
  5482.     movl    LTQ_TAIL_REG,ATEMP1
  5483.     movl    DISP(PSTATE_REG,SLOT(LTQ_HEAD)),ATEMP2
  5484. LBL(loop6):
  5485.     movl    PDEC(ATEMP1),DTEMP1
  5486.     CMPL(    ATEMP1,ATEMP2)
  5487.     BCCS(    ltq_reversed)
  5488.     movl    IND(ATEMP2),IND(ATEMP1)
  5489.     movl    DTEMP1,PINC(ATEMP2)
  5490.     BRAS(    loop6)
  5491. LBL(ltq_reversed):
  5492.  
  5493. /* Setup correct return address for parent and return to restored cont */
  5494.  
  5495.     movl    DISP(PSTATE_REG,SLOT(PARENT_RET)),ATEMP2
  5496.     movl    PVM0_REG,DISP(PSTATE_REG,SLOT(PARENT_RET))
  5497.  
  5498. #ifndef MESSAGE_PASSING_STEAL
  5499.     clrl    DISP(PSTATE_REG,SLOT(STEAL_LOCKO))
  5500. #endif
  5501.  
  5502. #ifdef debug
  5503. /*****/    addw    IMM(5*4),SP
  5504. /*****/    pea    PC_IND($entry)
  5505. /*****/    movl    PINC(SP),DISP(PSTATE_REG,SLOT(56))
  5506. /*****/    movl    ATEMP2,DISP(PSTATE_REG,SLOT(57))
  5507. /*****/    movl    IMM(0),DISP(PSTATE_REG,SLOT(58))
  5508. #endif
  5509.  
  5510.     movl    DISP(PSTATE_REG,SLOT(TEMP1)),PVM0_REG
  5511.     movl    DISP(PSTATE_REG,SLOT(TEMP2)),PVM1_REG
  5512.  
  5513.     movl    PVM1_REG,DTEMP1 /* Required for the case of a return from a touch of d0 */
  5514.  
  5515.     jmp    IND(ATEMP2)
  5516.  
  5517. CONSTS(3)
  5518. PRIMITIVE("###_kernel")
  5519. PRIMITIVE("###_kernel.idle")
  5520. PRIMITIVE("##startup")
  5521. END
  5522.  
  5523. /*---------------------------------------------------------------------------*/
  5524.  
  5525. OBJECT_FILE_END
  5526.