home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / SIMTEL / CPMUG / CPMUG023.ARK / STOICBAS.STC < prev    next >
Text File  |  1984-04-29  |  23KB  |  669 lines
  1.  
  2.  
  3. % ***************************************************************************
  4. % ** COPYRIGHT (C) MASSACHUSETTS INSTITUTE OF TECHNOLOGY AND HARVARD       **
  5. % ** UNIVERSITY, BIOMEDICAL ENGINEERING CENTER 1977.  ALL RIGHTS RESERVED. **
  6. % ***************************************************************************
  7.  
  8. % BASIC DEFINITIONS
  9. % J. SACHS 3/3/77
  10.  
  11. % 8080 ASSEMBLER
  12. ASSEMBLER< DEFINITIONS
  13.  
  14. % REGISTER DEFINITIONS
  15. 0 'B CONSTANT   1 'C CONSTANT   2 'D CONSTANT
  16. 3 'E CONSTANT   4 'H CONSTANT   5 'L CONSTANT
  17. 6 'M CONSTANT   7 'A CONSTANT
  18. 6 'PSW CONSTANT 6 'SP CONSTANT
  19.  
  20. % INSTRUCTION DEFINITIONS
  21. 000 'NOP,  R0   001 'LXI,  R6   011 'DAD,  R1   013 'DCX,  R1
  22. 002 'STAX, R1   012 'LDAX, R1   004 'INR,  R1   005 'DCR,  R1
  23. 042 'SHLD, R7   052 'LHLD, R7   062 'STA,  R7   072 'LDA,  R7
  24. 007 'RLC,  R0   017 'RRC,  R0   027 'RAL,  R0   037 'RAR,  R0
  25. 047 'DAA,  R0   057 'CMA,  R0   067 'STC,  R0   077 'CMC,  R0
  26. 006 'MVI,  R5   100 'MOV,  R2   301 'POP,  R1   305 'PUSH, R1
  27. 200 'ADD,  R3   210 'ADC,  R3   220 'SUB,  R3   230 'SBB,  R3
  28. 240 'ANA,  R3   250 'XRA,  R3   260 'ORA,  R3   270 'CMP,  R3
  29. 306 'ADI,  R4   316 'ACI,  R4   326 'SUI,  R4   336 'SBI,  R4
  30. 346 'ANI,  R4   356 'XRI,  R4   366 'ORI,  R4   376 'CPI,  R4
  31. 300 'RNZ,  R0   310 'RZ,   R0   320 'RNC,  R0   330 'RC,   R0
  32. 340 'RPO,  R0   350 'RPE,  R0   360 'RP,   R0   370 'RM,   R0
  33. 303 'JMP,  R7   315 'CALL, R7   311 'RET,  R0   003 'INX,  R1
  34. 302 'JNZ,  R7   312 'JZ,   R7   322 'JNC,  R7   332 'JC,   R7
  35. 342 'JPO,  R7   352 'JPE,  R7   362 'JP,   R7   372 'JM,   R7
  36. 304 'CNZ,  R7   314 'CZ,   R7   324 'CNC,  R7   334 'CC,   R7
  37. 344 'CPO,  R7   354 'CPE,  R7   364 'CP,   R7   374 'CM,   R7
  38. 323 'OUT,  R4   333 'IN,   R4   343 'XTHL, R0   353 'XCHG, R0
  39. 363 'DI,   R0   373 'EI,   R0   351 'PCHL, R0   371 'SPHL, R0
  40. 166 'HLT,  R0   307 'RST,  R1   303 'IF,   R8   302 'IFNZ, R8
  41. 312 'IFZ,  R8   322 'IFNC, R8   332 'IFC,  R8   342 'IFPO, R8
  42. 352 'IFPE, R8   362 'IFP,  R8   372 'IFM,  R8
  43.  
  44. > DEFINITIONS
  45.  
  46. % DROP TOP 3 NUMBERS FROM STACK
  47. '3DROP CODE<  H POP,  .  H POP,  .  H POP,  NEXT JMP,  >
  48.  
  49. % DROP TOP NUMBER FROM STACK
  50. 'DROP CODE<  JMP,  >
  51.  
  52. % DROP TOP 2 NUMBERS FROM STACK
  53. '2DROP CODE<  JMP,  >
  54.  
  55. % DUPLOCATE TOP OF STACK
  56. 'DUP CODE<  H POP,  H PUSH,  PUSH JMP,  >
  57.  
  58. % DUPLICATE TOP - 1
  59. 'OVER CODE<  2 H LXI,  SP DAD,  @PUSH JMP,  >
  60.  
  61. % EXCHANGE TOP 2 NUMBERS ON STACK
  62. 'SWAP CODE<  H POP,  XTHL,  PUSH JMP,  >
  63.  
  64. % LOAD NUMBER ADDRESSED BY TOP OF STACK
  65. '@ CODE<  H POP,  @PUSH JMP,  >
  66.  
  67. % STORE NUMBER AT TOP - 1 AT ADDRESS AT TOP
  68. '! CODE<  H POP,  D POP,  E M MOV,  H INX,  D M MOV,  NEXT JMP,  >
  69.  
  70. % INCREMENT TOP OF STACK
  71. '1+ CODE<  H POP,  H INX,  PUSH JMP,  >
  72.  
  73. % DECREMENT TOP OF STACK
  74. '1- CODE<  H POP,  H DCX,  PUSH JMP,  >
  75.  
  76. % INCREMENT TOP OF STACK BY 2
  77. '2+ CODE<  H POP,  H INX,  H INX,  PUSH JMP,  >
  78.  
  79. % DECREMENT TOP OF STACK BY 2
  80. '2- CODE<  H POP,  H DCX,  H DCX,  PUSH JMP,  >
  81.  
  82. % NEGATE TOP OF STACK
  83. 'MINUS CODE<  H POP,  -HL CALL,  PUSH JMP,  >
  84.  
  85. % COMPLEMENT TOP OF STACK
  86. 'NOT CODE<  H POP,  -HL 1+ CALL,  PUSH JMP,  >
  87.  
  88. % ADD TOP 2 NUMBERS ON STACK
  89. '+ CODE<  H POP,  D POP,  D DAD,  PUSH JMP,  >
  90.  
  91. % SUBTRACT TOP 2 NUMBERS ON  STACK
  92. '- CODE<  H POP,  -HL CALL,  D POP,  D DAD,  PUSH JMP,  >
  93.  
  94. % LOGICAL AND TOP 2 NUMBERS ON STACK
  95. 'AND CODE<  B POP,  H POP,  B A MOV,  H ANA,  A H MOV,
  96.   C A MOV,  L ANA,  A L MOV,  PUSH JMP,  >
  97.  
  98. % LOGICAL OR TOP 2 NUMBERS ON STACK
  99. 'OR CODE<  B POP,  H POP,  B A MOV,  H ORA,  A H MOV,
  100.   C A MOV,  L ORA,  A L MOV,  PUSH JMP,  >
  101.  
  102. % LOGICAL XOR TOP 2 NUMBERS ON STACK
  103. 'XOR CODE<  B POP,  H POP,  B A MOV,  H XRA,  A H MOV,
  104.   C A MOV,  L XRA,  A L MOV,  PUSH JMP,  >
  105.  
  106. % LOAD BYTE ADDRESSED BY TOP OF STACK
  107. 'B@ CODE<  H POP,  M L MOV,  0 H MVI,  PUSH JMP,  >
  108.  
  109. % STORE BYTE AT TOP - 1 AT ADDRESS AT TOP
  110. 'B! CODE<  H POP,  D POP,  E M MOV,  NEXT JMP,  >
  111.  
  112. % EXECUTE WORD WHOSE ADDRESS IS AT TOP OF STACK
  113. 'EXEC CODE<  D POP,  D H MOV,  E L MOV,  H DCX,  M A MOV,  H DCX,
  114.   M L MOV,  A H MOV,  PCHL,  >
  115.  
  116. % DEFINE COMMONLY USED CONSTANTS
  117. -1 '-1 CONSTANT
  118. 0 '0 CONSTANT
  119. 1 '1 CONSTANT
  120. 2 '2 CONSTANT
  121.  
  122. % DEFINE THE ADDRESSES OF VARIABLES INSIDE THE KERNEL
  123. %
  124. % NOTE THAT THESE OFFSETS MUST BE MODIFIED IF ANY VARIABLES
  125. % ARE ADDED, REMOVED, OR REARRANGED.
  126. %
  127. % IF "STATE" IS NOT THE 1ST STOIC VARIABLE, "RDCI" AND "WRCI"
  128. % MUST ALSO BE MODIFIED.
  129.  
  130. STATE 1 + 'CHECK CONSTANT
  131. STATE 2 + 'COLUMN CONSTANT
  132. STATE 5 + '.R CONSTANT
  133. STATE 7 + '.L CONSTANT
  134. STATE 11 + '.V CONSTANT
  135. STATE 13 + '.D CONSTANT
  136. STATE 15 + '.C CONSTANT
  137. STATE 17 + 'CURRENT CONSTANT
  138. STATE 21 + 'RADIX CONSTANT
  139. STATE 23 + 'PROMPT CONSTANT
  140. STATE 25 + 'ERRMSG CONSTANT
  141. STATE 27 + 'ENT CONSTANT
  142. STATE 31 + 'MEMORY CONSTANT
  143. STATE 33 + 'LIT CONSTANT
  144. STATE 35 + '(TTYIN) CONSTANT
  145. STATE 37 + '(TTYOU) CONSTANT
  146. STATE 41 + '(ABORT) CONSTANT
  147.  
  148. % FINISH UP ASSEMBLER
  149. ASSEMBLER< DEFINITIONS
  150.  
  151. STATE 3 + '.I CONSTANT
  152. STATE 57 + 'T1 CONSTANT
  153.  
  154. 'THEN, : . SWAP ! ;
  155. 'ELSE, : IF, SWAP THEN, ;
  156.  
  157. > DEFINITIONS
  158.  
  159. % COMPARISONS WITH ZERO
  160. 'EQZ CODE<  D POP,  D A MOV,  E ORA,  0PUSH JNZ,  -1PUSH JMP,  >
  161. 'NEZ CODE<  D POP,  D A MOV,  E ORA,  0PUSH JZ,  -1PUSH JMP,  >
  162. 'LTZ CODE<  D POP,  D A MOV,  A ORA,  0PUSH JP,  -1PUSH JMP,  >
  163. 'GEZ CODE<  D POP,  D A MOV,  A ORA,  0PUSH JM,  -1PUSH JMP,  >
  164. 'LEZ CODE<  D POP,  D DCX,  D A MOV,  A ORA,  0PUSH JP,  -1PUSH JMP,  >
  165. 'GTZ CODE<  D POP,  D DCX,  D A MOV,  A ORA,  0PUSH JM,  -1PUSH JMP,  >
  166.  
  167. % EQUALITY COMPARISONS
  168. 'EQ CODE<  H POP,  D POP,  H A MOV,  D CMP,  0PUSH JNZ,
  169.   L A MOV,  E CMP,  0PUSH JNZ,  -1PUSH JMP,  >
  170. 'NE CODE<  H POP,  D POP,  H A MOV,  D CMP,  -1PUSH JNZ,
  171.   L A MOV,  E CMP,  -1PUSH JNZ,  0PUSH JMP,  >
  172.  
  173. % SIGNED COMPARISONS
  174. 'LT CODE<  H POP,  D POP,  E A MOV,  L SUB,  D A MOV,  H SBB,
  175.   -1PUSH JM,  0PUSH JMP,  >
  176. 'GE CODE<  H POP,  D POP,  E A MOV,  L SUB,  D A MOV,  H SBB,
  177.   0PUSH JM,  -1PUSH JMP,  >
  178. 'LE CODE<  D POP,  H POP,  E A MOV,  L SUB,  D A MOV,  H SBB,
  179.   0PUSH JM,  -1PUSH JMP,  >
  180. 'GT CODE<  D POP,  H POP,  E A MOV,  L SUB,  D A MOV,  H SBB,
  181.   -1PUSH JM,  0PUSH JMP,  >
  182.  
  183. % UNSIGNED COMPARISONS
  184. 'ULT CODE<  H POP,  D POP,  E A MOV,  L SUB,  D A MOV,  H SBB,
  185.   -1PUSH JC,  0PUSH JMP,  >
  186. 'UGE CODE<  H POP,  D POP,  E A MOV,  L SUB,  D A MOV,  H SBB,
  187.   0PUSH JC,  -1PUSH JMP,  >
  188. 'ULE CODE<  D POP,  H POP,  E A MOV,  L SUB,  D A MOV,  H SBB,
  189.   0PUSH JC,  -1PUSH JMP,  >
  190. 'UGT CODE<  D POP,  H POP,  E A MOV,  L SUB,  D A MOV,  H SBB,
  191.   -1PUSH JC,  0PUSH JMP,  >
  192.  
  193. % LOAD INDIRECT TOP OF STACK
  194. '@@ CODE<  H POP,  M E MOV,  H INX,  M D MOV,  XCHG,  @PUSH JMP,  >
  195.  
  196. % STORE TOP - 1 INDIRECT TOP OF STACK
  197. '@! CODE<  H POP,  M E MOV,  H INX,  M D MOV,  XCHG,  D POP,  E M MOV,
  198.   H INX,  D M MOV,  NEXT JMP,  >
  199.  
  200. % INCREMENT WORD ADDRESSED BY TOP OF STACK
  201. '1+! CODE<  H POP,  M INR,  NEXT JNZ,  H INX,  M INR,  NEXT JMP,  >
  202.  
  203. % DECREMENT WORD ADDRESSED BY TOP OF STACK
  204. '1-! CODE<  H POP,  M E MOV,  H INX,  M D MOV,  D DCX,  D M MOV,
  205.   H DCX,  E M MOV,  NEXT JMP,  >
  206.  
  207. % MOVE BYTES FORWARD FROM ADDRESS AT TOP - 2 TO ADDRESS AT TOP - 1
  208. % BYTE COUNT AT TOP
  209. 'MVBYTES CODE<  H POP,  D POP,  B POP,  H A MOV,  A ORA,  NEXT JM,
  210.   L ORA,  NEXT JZ,  .  B LDAX,  D STAX,  B INX,  D INX,  H DCX,  H A MOV,
  211.   L ORA,  JNZ,  NEXT JMP,  >
  212.  
  213. % MOVE BYTES BACKWARD FROM ADDRESS AT TOP - 2 TO ADDRESS AT TOP - 1
  214. % BYTE COUNT AT TOP
  215. 'RMVBYTES CODE<  H POP,  D POP,  B POP,  H A MOV,  A ORA,  NEXT JM,
  216.   L ORA,  NEXT JZ,  .  B LDAX,  D STAX,  B DCX,  D DCX,  H DCX,  H A MOV,
  217.   L ORA,  JNZ,  NEXT JMP,  >
  218.  
  219. % FILL ARRAY WHOSE ADDRESS IS AT TOP - 2 WITH DATA AT TOP
  220. % WORD COUNT AT TOP - 1
  221. 'FILL CODE<  D POP,  .  B POP,  H POP,  B A MOV,  A ORA,  NEXT JM,
  222.   C ORA,  NEXT JZ,  .  E M MOV,  H INX,  D M MOV,  H INX,  B DCX,
  223.   B A MOV,  C ORA,  JNZ,  NEXT JMP,  >
  224.  
  225. % ZERO FILL ARRAY WHOSE ADDRESS IS AT TOP - 1
  226. % WORD COUNT AT TOP
  227. '0FILL CODE<  0 D LXI,  JMP,  >
  228.  
  229. % ADD NUMBER AT TOP - 1 TO LOCATION ADDRESSED BY TOP
  230. '+! CODE<  H POP,  M E MOV,  H INX,  M D MOV,  XCHG,  B POP,  B DAD,
  231.   XCHG,  D M MOV,  H DCX,  E M MOV,  NEXT JMP,  >
  232.  
  233. % SET PRECEDENCE BIT OF MOST RECENTLY DEFINED WORD
  234. 'IMMEDIATE CODE<  CURRENT LHLD,  M E MOV,  H INX,  M D MOV,  -12 H LXI,
  235.   D DAD,  M A MOV,  200 XRI,  A M MOV,  NEXT JMP,  >
  236.  
  237. % STORE TOP AT LOCATION ADDRESSED BY TOP - 1
  238. '<- CODE<  D POP,  H POP,  E M MOV,  H INX,  D M MOV,  NEXT JMP,  >
  239.  
  240. % STORE ZERO AT LOCATION ADDRESSED BY TOP
  241. '0<- CODE<  H POP,  0 M MVI,  H INX,  0 M MVI,  NEXT JMP,  >
  242.  
  243. % STORE ONES AT LOCATION ADDRESSED BY TOP
  244. '-1<- CODE<  H POP,  -1 M MVI,  H INX,  -1 M MVI,  NEXT JMP,  >
  245.  
  246. % APPEND STRING WHOSE ADDRESS IS AT TOP TO END OF DICTIONARY
  247. 'S, CODE<  H POP,  M A MOV,  A INR,  .  H PUSH,  PSW PUSH,  M A MOV,
  248.   (B,) CALL,  PSW POP,  H POP,  H INX,  A DCR,  NEXT JZ,  JMP,  >
  249.  
  250. ASSEMBLER< DEFINITIONS
  251.  
  252. % NEGATE (BC)
  253. .
  254.   B DCX,  B A MOV,  CMA,  A B MOV,  C A MOV,  CMA,  A C MOV,  RET,
  255. '-BC CONSTANT
  256.  
  257. % NEGATE (DE)
  258. .
  259.   D DCX,  D A MOV,  CMA,  A D MOV,  E A MOV,  CMA,  A E MOV,  RET,
  260. '-DE CONSTANT
  261.  
  262. % NEGATE (HL,DE)
  263. .
  264.   -HL 1+ CALL,  -DE CALL,  D A MOV,  E ORA,  RNZ,  H INX,  RET,
  265. '-HLDE CONSTANT
  266.  
  267. % SIGNED MULTIPLY (HL)*(DE)->(HLDE)
  268. .
  269.   D A MOV,  H XRA,  PSW PUSH,  D A MOV,
  270.   A ORA,  -DE CM,  H A MOV,  A ORA,  -HL CM,
  271.   MUL CALL,  PSW POP,  -HLDE CM,  RET,
  272. 'SMUL CONSTANT
  273.  
  274. % UNSIGNED DIVIDE (HLDE)/(BC)->(DE),(HL) (QUOTIENT,REMAINDER)
  275. .
  276.   -BC CALL,  20 A MVI,  . <L  . <L  . <L  H DAD,  IFC,  XCHG,  H DAD,
  277.   XCHG,  IFNC,  L INR,  THEN,  H PUSH,  B DAD,  IFC,  H POP,  A DCR,
  278.   L> JNZ,  RET,  THEN,  E INR,  SP INX,  SP INX,  A DCR,  L> JNZ,  RET,
  279.   THEN,  XCHG,  H DAD,  XCHG,  IFNC,  L INR,  THEN,  B DAD,  E INR,
  280.   A DCR,  L> JNZ,  RET,
  281. 'DIV CONSTANT
  282.  
  283. % SIGNED DIVIDE SUBROUTINE
  284. .
  285.   H A MOV,  A ORA,  PSW PUSH,  B XRA,
  286.   PSW PUSH,  H A MOV,  A ORA,  -HLDE CM,  B A MOV,
  287.   A ORA,  -BC CM,  DIV CALL,  PSW POP,  -DE CM,
  288.   PSW POP,  -HL CM,  RET,
  289. 'SDIV CONSTANT
  290. > DEFINITIONS
  291.  
  292. % PUSH CURRENT VALUE OF COMPILE BUFFER OUTPUT PTR
  293. 'C. CODE<  .C LHLD,  PUSH JMP,  >
  294.  
  295. % INCREMENT CHECK
  296. '+CHECK CODE<  CHECK H LXI,  M INR,  NEXT JMP,  >
  297.  
  298. % DECREMENT CHECK, ERROR IF MINUS
  299. . "SYNTAX ERROR" S,
  300. '-CHECK CODE<  CHECK H LXI,  M DCR,  M A MOV,  60 CPI,  NEXT JP,
  301.   H LXI,  ERROR JMP,  >
  302.  
  303. % DEFINE BEGIN, END, REPEAT, IF, THEN, ELSE
  304. 'BEGIN : +CHECK C. 2- ;  IMMEDIATE
  305. 'END : -CHECK () (IF) C, C. - C, ;  IMMEDIATE
  306. 'REPEAT : -CHECK -CHECK SWAP () (ELSE) C, C. - C, C. 2- OVER - <- ;  IMMEDIATE
  307. 'IF : +CHECK () (IF) C, C. 0 C, ;  IMMEDIATE
  308. 'THEN : -CHECK C. 2- OVER - <- ;  IMMEDIATE
  309. 'ELSE : -CHECK +CHECK () (ELSE) C, C. OVER - <- C. 0 C, ;  IMMEDIATE
  310.  
  311. % DEFINE (, U(, )
  312. '(() CODE<  D POP,  D A MOV,  A ORA,  () (ELSE) JM,  .  E ORA,  () (ELSE) JZ,
  313.   .L LHLD,  6 B LXI,  B DAD,  .L SHLD,  E M MOV,  H INX,  D M MOV,  .I LHLD,
  314.   H INX,  H INX,  .I SHLD,  NEXT JMP,  >
  315. '(U() CODE<  D POP,  D A MOV,  JMP,  >
  316. '()) CODE<  .L LHLD,  M E MOV,  H INX,  M D MOV,  D DCX,  D M MOV,  H DCX,
  317.   E M MOV,  D A MOV,  E ORA,  () (ELSE) JNZ,  .L LHLD,  -6 D LXI,  D DAD,
  318.   .L SHLD,  .I LHLD,  H INX,  H INX,  .I SHLD,  NEXT JMP,  >
  319.  
  320. '( : +CHECK () (() C, C. 0 C, ;  IMMEDIATE
  321. 'U( : +CHECK () (U() C, C. 0 C, ;  IMMEDIATE
  322. ') : -CHECK () ()) C, DUP C. OVER - <- C. - C, ;  IMMEDIATE
  323.  
  324. % DEFINE DO, LOOP, AND +LOOP
  325. '(DO) CODE<  D POP,  B POP,  E A MOV,  C SUB,  D A MOV,  B SBB,
  326.   () (ELSE) JP,  .L LHLD,  H INX,  H INX,  E M MOV,  H INX,  D M MOV,
  327.   H INX,  C M MOV,  H INX,  B M MOV,  H INX,  .L SHLD,  E M MOV,  H INX,
  328.   D M MOV,  .I LHLD,  H INX,  H INX,  .I SHLD,  NEXT JMP,  >
  329. '(LOOP) CODE<  .L LHLD,  M E MOV,  H INX,  M D MOV,  D INX,  .  D M MOV,
  330.   H DCX,  E M MOV,  H DCX,  M B MOV,  H DCX,  M C MOV,  E A MOV,  C SUB,
  331.   D A MOV,  B SBB,  () (ELSE) JM,  .L LHLD,  -6 D LXI,  D DAD,  .L SHLD,
  332.   .I LHLD,  H INX,  H INX,  .I SHLD,  NEXT JMP,  >
  333. '(+LOOP) CODE<  .L LHLD,  M E MOV,  H INX,  M D MOV,  XCHG,  B POP,
  334.   B DAD,  XCHG,  JMP,  >
  335.  
  336. 'DO : +CHECK () (DO) C, C. 0 C, ;  IMMEDIATE
  337. 'LOOP : -CHECK () (LOOP) C, DUP C. OVER - <- C. - C, ;  IMMEDIATE
  338. '+LOOP : -CHECK () (+LOOP) C, DUP C. OVER - <- C. - C, ;  IMMEDIATE
  339.  
  340. % DEFINE UDO, ULOOP, AND U+LOOP
  341. '(UDO) CODE<  D POP,  B POP,  E A MOV,  C SUB,  D A MOV,  B SBB,
  342.   () (ELSE) JNC,  .L LHLD,  H INX,  H INX,  E M MOV,  H INX,  D M MOV,
  343.   H INX,  C M MOV,  H INX,  B M MOV,  H INX,  .L SHLD,  E M MOV,  H INX,
  344.   D M MOV,  .I LHLD,  H INX,  H INX,  .I SHLD,  NEXT JMP,  >
  345. '(ULOOP) CODE<  .L LHLD,  M E MOV,  H INX,  M D MOV,  D INX,  .  D M MOV,
  346.   H DCX,  E M MOV,  H DCX,  M B MOV,  H DCX,  M C MOV,  E A MOV,  C SUB,
  347.   D A MOV,  B SBB,  () (ELSE) JC,  .L LHLD,  -6 D LXI,  D DAD,  .L SHLD,
  348.   .I LHLD,  H INX,  H INX,  .I SHLD,  NEXT JMP,  >
  349. '(U+LOOP) CODE<  .L LHLD,  M E MOV,  H INX,  M D MOV,  XCHG,  B POP,
  350.   B DAD,  XCHG,  JMP,  >
  351.  
  352. 'UDO : +CHECK () (UDO) C, C. 0 C, ;  IMMEDIATE
  353. 'ULOOP : -CHECK () (ULOOP) C, DUP C. OVER - <- C. - C, ;  IMMEDIATE
  354. 'U+LOOP : -CHECK () (U+LOOP) C, DUP C. OVER - <- C. - C, ;  IMMEDIATE
  355.  
  356. % DO LOOP INDICES
  357. 'I CODE<  .L LHLD,  @PUSH JMP,  >
  358. 'J CODE<  .L LHLD,  -6 D LXI,  D DAD,  @PUSH JMP,  >
  359. 'K CODE<  .L LHLD,  -14 D LXI,  D DAD,  @PUSH JMP,  >
  360.  
  361. % REVERSE DO LOOP INDICES
  362. 'I' CODE<  .L LHLD,  . .  H INX,  M D MOV,  H DCX,  M E MOV,  H DCX,
  363.   -DE 1+ CALL,  M B MOV,  H DCX,  M C MOV,  H DCX,  XCHG,  B DAD,
  364.   XCHG,  M B MOV,  H DCX,  M C MOV,  XCHG,  B DAD,  PUSH JMP,  >
  365. 'J' CODE<  -6 D LXI,  .L LHLD,  D DAD,  JMP,  >
  366. 'K' CODE<  -14 D LXI,  .L LHLD,  D DAD,  JMP,  >
  367.  
  368. % EXIT FROM DO LOOP OR ITERATION BRACKETS
  369. 'EXIT CODE<  .L LHLD,  H INX,  0 M MVI,  H DCX,  1 M MVI,  H DCX,  0 M MVI,
  370.   H DCX,  1 M MVI,  NEXT JMP,  >
  371.  
  372. % PUSH NUMBER ON RETURN STACK
  373. '<R CODE<  .R LHLD,  H INX,  H INX,  .R SHLD,  D POP,  E M MOV,  H INX,
  374.   D M MOV,  NEXT JMP,  >
  375.  
  376. % POP NUMBER FROM RETURN STACK
  377. 'R> CODE<  .R LHLD,  M E MOV,  H INX,  M D MOV,  H DCX,  H DCX,  H DCX,
  378.   .R SHLD,  PUSHD JMP,  >
  379.  
  380. % ABSOLUTE VALUE OF TOP OF STACK
  381. 'ABS CODE<  H POP,  H A MOV,  A ORA,  -HL CM,  PUSH JMP,  >
  382.  
  383. % ADD NUMBER AT TOP TO DOUBLE PRECISION INTEGER AT TOP-2,TOP-1
  384. 'M+ CODE<  B POP,  .  D POP,  H POP,  B DAD,  XCHG,  DPUSH JNC,  H INX,
  385.   DPUSH JMP,  >
  386.  
  387. % SUBTRACT NUMBER AT TOP FROM DOUBLE PRECISION INTEGER AT TOP-2,TOP-1
  388. 'M- CODE<  B POP,  -BC CALL,  JMP,  >
  389.  
  390. % DIVIDE TOP OF STACK BY 2 (SIGNED)
  391. '2/ CODE<  H POP,  H A MOV,  A ORA,  IFP,  STC,  THEN,  .  RAR,
  392.   A H MOV,  L A MOV,  RAR,  A L MOV,  PUSH JMP,  >
  393.  
  394. % DIVIDE TOP OF STACK BY 2 (UNSIGNED)
  395. 'U2/ CODE<  H POP,  H A MOV,  A ORA,  JMP,  >
  396.  
  397. % MULTIPLY TOP OF STACK BY 2
  398. '2* CODE<  H POP,  H DAD,  PUSH JMP,  >
  399.  
  400. % LEFT SHIFT TOP - 1 N PLACES; N AT TOP
  401. 'LSHIFT CODE<  D POP,  H POP,  D A MOV,  A ORA,  PUSH JM,  E ORA,
  402.   .  PUSH JZ,  H DAD,  E DCR,  JMP,  >
  403.  
  404. % RIGHT SHIFT TOP - 1 N PLACES; N AT TOP
  405. 'RSHIFT CODE<  D POP,  H POP,  D A MOV,  A ORA,  PUSH JM,  E ORA,
  406.   .  PUSH JZ,  H A MOV,  RAL,  H A MOV,  RAR,  A H MOV,  L A MOV,  RAR,
  407.   A L MOV,  E DCR,  JMP,  >
  408.  
  409. % UNSIGNED RIGHT SHIFT TOP - 1 N PLACES; N AT TOP
  410. 'URSHIFT CODE<  D POP,  H POP,  D A MOV,  A ORA,  PUSH JM,  E ORA,
  411.   .  PUSH JZ,  A ORA,  H A MOV,  RAR,  A H MOV,  L A MOV,  RAR,  A L MOV,
  412.   E DCR,  JMP,  >
  413.  
  414. % LEFT SHIFT TOP-2,TOP-1 N PLACES; N AT TOP
  415. 'DLSHIFT CODE<  B POP,  H POP,  D POP,  B A MOV,  A ORA,  DPUSH JM,
  416.   C ORA,  .  DPUSH JZ,  XCHG,  H DAD,  PSW PUSH,  XCHG,  H DAD,  PSW POP,
  417.   IFNC,  H INX,  THEN,  C DCR,  JMP,  >
  418.  
  419. % RIGHT SHIFT TOP-2,TOP-1 N PLACES; N AT TOP
  420. 'DRSHIFT CODE<  B POP,  H POP,  D POP,  B A MOV,  A ORA,  DPUSH JM,  C ORA,
  421.   .  DPUSH JZ,  H A MOV,  RAL,  H A MOV,  RAR,  A H MOV,  L A MOV,  RAR,
  422.   A L MOV,  D A MOV,  RAR,  A D MOV,  E A MOV,  RAR,  A E MOV,  C DCR,  JMP,  >
  423.  
  424. % UNSIGNED RIGHT SHIFT TOP-2,TOP-1 N PLACES; N AT TOP
  425. 'DURSHIFT CODE<  B POP,  H POP,  D POP,  B A MOV,  A ORA,  DPUSH JM,  C ORA,
  426.   .  DPUSH JZ,  A ORA,  H A MOV,  RAR,  A H MOV,  L A MOV,  RAR,  A L MOV,
  427.   D A MOV,  RAR,  A D MOV,  E A MOV,  RAR,  A E MOV,  C DCR,  JMP,  >
  428.  
  429. % MISCELLANEOUS FIXED POINT MULTIPLY AND DIVIDE OPERATORS
  430. 'UM* CODE<  D POP,  H POP,  MUL CALL,  DPUSH JMP,  >
  431. 'U* CODE<  D POP,  H POP,  MUL CALL,  PUSHD JMP,  >
  432. 'U/ CODE<  B POP,  0 H LXI,  D POP,  DIV CALL,  PUSHD JMP,  >
  433. 'U/MOD CODE<  B POP,  0 H LXI,  D POP,  DIV CALL,  DPUSH JMP,  >
  434. 'UM/MOD CODE<  B POP,  H POP,  D POP,  DIV CALL,  DPUSH JMP,  >
  435. 'UMOD CODE<  B POP,  0 H LXI,  D POP,  DIV CALL,  PUSH JMP,  >
  436. 'UM/ CODE<  B POP,  H POP,  D POP,  DIV CALL,  PUSHD JMP,  >
  437. 'U*/ CODE<  B POP,  D POP,  H POP,  B PUSH,  MUL CALL,  B POP,
  438.   DIV CALL,  PUSHD JMP,  >
  439.  
  440. '* CODE<  D POP,  H POP,  SMUL CALL,  PUSHD JMP,  >
  441. '/ CODE<  B POP,  D POP,  D A MOV,  A ORA,  0 H LXI,  IFP,  H DCX,  THEN,
  442.   SDIV CALL,  PUSHD JMP,  >
  443. 'MOD CODE<  B POP,  D POP,  D A MOV,  A ORA,  0 H LXI,  IFP,  H DCX,  THEN,
  444.   SDIV CALL,  PUSH JMP,  >
  445. 'M* CODE<  D POP,  H POP,  SMUL CALL,  DPUSH JMP,  >
  446. 'M/ CODE<  B POP,  H POP,  D POP,  SDIV CALL,  PUSHD JMP,  >
  447. '/MOD CODE<  B POP,  D POP,  D A MOV,  A ORA,  0 H LXI,  IFP,  H DCX,  THEN,
  448.   SDIV CALL,  DPUSH JMP,  >
  449. 'M/MOD CODE<  B POP,  H POP,  D POP,  SDIV CALL,  DPUSH JMP,  >
  450. '*/ CODE<  B POP,  D POP,  H POP,  B PUSH,  SMUL CALL,  B POP,
  451.   SDIV CALL,  PUSHD JMP,  >
  452.  
  453. % MOVE NUMBER ADDRESSED BY TOP - 1 TO LOCATION ADDRESSED BY TOP
  454. 'MOVE CODE<  B POP,  D POP,  D LDAX,  B STAX,  D INX,  B INX,  D LDAX,
  455.   B STAX,  NEXT JMP,  >
  456.  
  457. % EXCHANGE NUMBER ADDRESSED BY TOP - 1 WITH NUMBER ADDRESSED BY TOP
  458. 'XCHG CODE<  D POP,  H POP,  M C MOV,  D LDAX,  A M MOV,  C A MOV,  D STAX,
  459.   H INX,  D INX,  M C MOV,  D LDAX,  A M MOV,  C A MOV,  D STAX,  NEXT JMP,  >
  460.  
  461. % GET CURRENT VALUE OF STACK PTR
  462. 'S@ CODE<  0 H LXI,  SP DAD,  PUSH JMP,  >
  463.  
  464. % COPY TOP - 2
  465. '2OVER CODE<  4 H LXI,  SP DAD,  @PUSH JMP,  >
  466.  
  467. % COPY TOP - 3
  468. '3OVER CODE<  6 H LXI,  SP DAD,  @PUSH JMP,  >
  469.  
  470. % STORE TOP AT TOP - 1
  471. 'UNDER CODE<  H POP,  D POP,  PUSH JMP,  >
  472.  
  473. % STORE TOP AT TOP - 2
  474. '2UNDER CODE<  4 H LXI,  .  SP DAD,  D POP,  E M MOV,  H INX,  D M MOV,
  475.   NEXT JMP,  >
  476.  
  477. % STORE TOP AT TOP - 3
  478. '3UNDER CODE<  6 H LXI,  JMP,  >
  479.  
  480. % DUPLICATE TOP-1,TOP
  481. 'DDUP CODE<  H POP,  D POP,  D PUSH,  H PUSH,  DPUSH JMP,  >
  482.  
  483. % DUPLICATE TOP-3,TOP-2
  484. 'DOVER CODE<  6 H LXI,  SP DAD,  M E MOV,  H INX,  M D MOV,  D PUSH,
  485.   H DCX,  H DCX,  H DCX,  @PUSH JMP,  >
  486.  
  487. % STORE TOP-1,TOP AT TOP-3,TOP-2
  488. 'DUNDER CODE<  H POP,  D POP,  B POP,  B POP,  DPUSH JMP,  >
  489.  
  490. % EXCHANGE TOP-1,TOP WITH TOP-3,TOP-2
  491. 'DSWAP CODE<  B POP,  H POP,  T1 SHLD,  H POP,  T1 2+ SHLD,  D POP,
  492.   T1 LHLD,  H PUSH,  B PUSH,  T1 2+ LHLD,  DPUSH JMP,  >
  493.  
  494. % EXCHANGE TOP-2 WITH TOP-1
  495. '2SWAP CODE<  H POP,  B POP,  D POP,  B PUSH,  DPUSH JMP,  >
  496.  
  497. % TOP -> TOP-2 -> TOP-1 -> TOP
  498. '+ROT CODE<  B POP,  H POP,  D POP,  B PUSH,  DPUSH JMP,  >
  499.  
  500. % TOP -> TOP-1 -> TOP-2 -> TOP
  501. '-ROT CODE<  D POP,  B POP,  H POP,  B PUSH,  DPUSH JMP,  >
  502.  
  503. % EXCHANGE TOP WITH TOP-2
  504. 'FLIP CODE<  B POP,  D POP,  H POP,  B PUSH,  DPUSH JMP,  >
  505.  
  506. % SET RADIX TO OCTAL
  507. 'OCTAL : 10 RADIX ! ;
  508.  
  509. % SET RADIX TO DECIMAL
  510. 'DECIMAL : 12 RADIX ! ;
  511.  
  512. % SET RADIX TO HEXADECIMAL
  513. 'HEX : 20 RADIX ! ;
  514.  
  515. % DEFINE VARIABLE, ARRAY
  516. 'VARIABLE : CONSTANT ;CODE< PUSHD JMP, >
  517. 'ARRAY : 0 SWAP VARIABLE 1- ( 0 , ) ;
  518.  
  519. % DEFINE BRANCH
  520. 'BRANCH : . 14 + SWAP CONSTANT 0 , ;CODE<  (BRANCH) JMP,  >
  521.  
  522. % LOOK UP STRING WHOSE ADDRESS IS AT TOP, RETURN ADDR OF WORD IF FOUND
  523. 'ADDRESS : LOOKUP NOT IF "UNDEFINED" ERR THEN ;
  524.  
  525. % DELETE DICTIONARY ENTRIES BACK TO WORD WHOSE NAME IS AT TOP
  526. 'FORGET : ADDRESS DUP 12 - .D ! 4 - @ CURRENT @! ;
  527.  
  528. % SIGNED MAXIMUM OF TOP, TOP-1
  529. 'MAX : DDUP GT IF DROP ELSE UNDER THEN ;
  530.  
  531. % SIGNED MINIMUM OF TOP, TOP-1
  532. 'MIN : DDUP LT IF DROP ELSE UNDER THEN ;
  533.  
  534. % UNSIGNED MAXIMUM OF TOP, TOP-1
  535. 'UMAX : DDUP UGT IF DROP ELSE UNDER THEN ;
  536.  
  537. % UNSIGNED MINIMUM OF TOP, TOP-1
  538. 'UMIN : DDUP ULT IF DROP ELSE UNDER THEN ;
  539.  
  540. % GET BYTE COUNT, BYTE POINTER TO STRING WHOSE ADDRESS IS AT TOP
  541. 'COUNT CODE<  H POP,  M A MOV,  H INX,  H PUSH,  0 H MVI,  A L MOV,
  542.   PUSH JMP,  >
  543.  
  544. % OUTPUT A BYTE TO TTY
  545. '<TTO> CODE<  H POP,  L A MOV,  (TTO) CALL,  NEXT JMP,  >
  546.  
  547. % INPUT A BYTE FROM TTY
  548. '<TTI> CODE<  (TTI) CALL,  A L MOV,  0 H MVI,  PUSH JMP,  >
  549.  
  550. % SET UP CHARACTER INPUT, OUTPUT VARIABLES
  551. () <TTO> 'OUT VARIABLE
  552. () <TTI> 'IN VARIABLE
  553.  
  554. % DEFINE CHARACTER INPUT, OUTPUT WORDS
  555. 'TYO : OUT @ EXEC ;
  556. 'TYI : IN @ EXEC ;
  557.  
  558. % OUTPUT N BYTES STARTING AT ADDRESS AT TOP - 1; N AT TOP
  559. 'TYPE : OVER + SWAP UDO I B@ TYO ULOOP ;
  560.  
  561. % OUTPUT STRING WHOSE ADDRESS IS AT TOP
  562. 'MSG : COUNT TYPE ;
  563.  
  564. % OUTPUT AT CARRIAGE RETURN
  565. 'CR : 15 TYO ;
  566.  
  567. % OUTPUT A CARRAIGE RETURN IS COLUMN IS NON-ZERO
  568. 'IFCR : COLUMN B@ IF CR THEN ;
  569.  
  570. % OUTPUT A SPACE
  571. 'SPACE : 40 TYO ;
  572.  
  573. % OUTPUT N SPACES; N AT TOP
  574. 'SPACES : ( SPACE ) ;
  575.  
  576. % TAB TO COLUMN N; N AT TOP
  577. 'TAB : COLUMN B@ - SPACES ;
  578.  
  579. % COMPLEMENT STATE
  580. '// CODE<  STATE LDA,  CMA,  STATE STA,  NEXT JMP,  >  IMMEDIATE
  581.  
  582. % GIVE "REDEFINING" ERROR ON ENTER
  583. 'ENT0 : DUP LOOKUP IF DROP IFCR "REDEFINING " MSG DUP MSG CR THEN ENT0 ;
  584. () ENT0 ENT !
  585.  
  586. % NUMBER CONVERSION PACKAGE
  587.  
  588. 0 '#CNT VARIABLE    % STRING LENGTH
  589. 0 '#PTR VARIABLE    % POINTER TO STRING
  590.  
  591. % OUTPUT A BYTE TO NUMBER STRING
  592. '#PUT CODE<  #CNT LHLD,  H INX,  #CNT SHLD,  #PTR LHLD,  H DCX,  #PTR SHLD,
  593.   D POP,  E M MOV,  NEXT JMP,  >
  594.  
  595. % INITIATE NUMBER CONVERSION
  596. '<# CODE<  .D LHLD,  40 D LXI,  D DAD,  #PTR SHLD,  0 H LXI,  #CNT SHLD,
  597.   NEXT JMP,  >
  598.  
  599. % TERMINATE NUMBER CONVERSION
  600. '#> CODE<  H POP,  #PTR LHLD,  XCHG,  #CNT LHLD,  DPUSH JMP,  >
  601.  
  602. % CONVERT A NUMBER AT TOP TO AN ASCII DIGIT
  603. '#A CODE<  H POP,  -12 D LXI,  D DAD,  IFNC,  7 D LXI,  D DAD,  THEN,
  604.   72 D LXI,  D DAD,  PUSH JMP,  >
  605.  
  606. % CONVERT NEXT DIGIT
  607. '# : RADIX @ U/MOD #A #PUT ;
  608.  
  609. % CONVERT DIGITS UNTIL RESULT IS ZERO
  610. '#S : BEGIN # DUP EQZ END ;
  611.  
  612. % UNSIGNED CONVERT
  613. 'U<#> : <# #S #> ;
  614.  
  615. % UNSIGNED CONVERT AND TYPE
  616. 'U= : U<#> TYPE SPACE ;
  617.  
  618. % TYPE UNSIGNED NUMBER ADDRESSED BY TOP
  619. 'U? : @ U= ;
  620.  
  621. % SIGNED NUMBER CONVERT
  622. '<#> : DUP <L ABS <# #S L> LTZ IF 55 #PUT THEN #> ;
  623.  
  624. % SIGNED NUMBER CONVERT AND TYPE
  625. '= : <#> TYPE SPACE ;
  626.  
  627. % TYPE SIGNED NUMBER ADDRESSED BY TOP
  628. '? : @ = ;
  629.  
  630. % DEFINE ;:
  631. ';: : CONSTANT R> , ;CODE<  D PUSH,  XCHG,  H INX,  H INX,  M E MOV,
  632.   H INX,  M D MOV,  .I LHLD,  XCHG,  .I SHLD,  .R LHLD,  H INX,  H INX,
  633.   .R SHLD,  E M MOV,  H INX,  D M MOV,  H POP,  @PUSH JMP,  >
  634.  
  635. % ROUTINE: SZSTOIC BY WINK SAVILLE
  636. % PURP:    DETERMINE THE # OF 256 BYTE PAGES USED BY STOIC
  637. % ENTRY: NONE
  638. % EXIT: THE MESSAGE
  639. %     STOIC IS XX DECIMAL PAGES LONG 
  640. %     WHERE XX IS THE # OF 256 BYTE PAGES
  641.  
  642. % FIRST CHANGE THE RADIX TO DECIMAL
  643. DECIMAL
  644.  
  645. %
  646. 'SZSTOIC :
  647. % SAVE PRESENT RADIX AND THEN CHANGE TO DECIMAL
  648. RADIX @ DECIMAL
  649. %
  650. % TYPE OUT FIRST PART OF THE MESSAGE
  651. "STOIC IS " MSG
  652.  
  653. % COMPUTE THE SIZE
  654. . 256 / 1+ U=
  655.  
  656. % PRINT THE LAST PART OF THE MESSAGE
  657. " DECIMAL PAGES LONG" MSG
  658.  
  659. % RESTORE OLD RADIX
  660. RADIX !
  661.  
  662. ;
  663.  
  664. ;F
  665.  
  666.  
  667.  
  668. ***EOF***
  669.