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 / STOICMIS.STC < prev    next >
Text File  |  1984-04-29  |  3KB  |  94 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. % MISCELLANEOUS DEFINITIONS
  9. % J. SACHS 3/3/77
  10.  
  11. RADIX @ OCTAL
  12.  
  13. % 'VOCABULARY-NAME LIST
  14. % LISTS OUT THE NAMES AND ADDRESSED OF ALL WORDS IN VOCABULARY
  15. 0 'COL VARIABLE
  16.  
  17. 'FORMAT : COL @ 4 EQ IF CR COL 0<- ELSE COL @ 1+ 16 U*
  18.   TAB COL 1+! THEN ;
  19.  
  20. 'LIST : ADDRESS @@ COL 0<- BEGIN DUP 12 - COUNT 5 MIN TYPE COL @
  21.   1+ 16 U* 7 - TAB DUP U= FORMAT 4 - @ DUP EQZ END DROP
  22.   CR "END OF LIST" MSG ;
  23.  
  24. % COMPILE CODE TO PUSH THE ASCII CODE OF THE 1ST CHAR OF THE
  25. % FOLLOWING WORD (PUSHES A NULL IF FOLLOWED BY END OF LINE)
  26. 'ASCII : WORD () () C, IF 0 ELSE . 1+ B@ THEN C, ; IMMEDIATE
  27.  
  28. % SIGNED DUMP MEMORY
  29. % ADDRESS COUNT DUMP
  30. 'DUMP : OVER + SWAP DO I <#> TYPE ASCII / TYO SPACE
  31.     20 0 DO I 1+ 4 * TAB
  32.     I J + ? 2 +LOOP CR 20 +LOOP ;
  33.  
  34. % UNSIGNED DUMP MEMORY
  35. % ADDRESS COUNT UDUMP
  36. 'UDUMP : OVER + SWAP DO I <#> TYPE ASCII / TYO SPACE
  37.     20 0 DO I 1+ 4 * TAB
  38.     I J + U? 2 +LOOP CR 20 +LOOP ;
  39.  
  40. % ASCII MEMORY DUMP
  41. % ADDRESS COUNT ADUMP
  42. 'CHAR= : DUP 40 LT OVER 137 GT OR IF ASCII < TYO
  43.   U<#> TYPE ASCII > TYO ELSE TYO THEN ;
  44.  
  45. 'A= : 400 U/MOD CHAR= CHAR= ;
  46.  
  47. 'A? : @ A= ;
  48.  
  49. 'ADUMP : OVER + SWAP DO I <#> TYPE ASCII / TYO SPACE
  50.     20 0 DO I J + A? 2 +LOOP CR 20 +LOOP ;
  51.  
  52. % ACCEPT A NUMBER FROM THE KEYBOARD
  53. % RETURNS A 0 AT TOP IF NOT A LEGAL NUMBER
  54. % OTHERWISE A -1 AT TOP, NUMBER AT TOP - 1
  55. 'ACCEPT : RDLINE WORD IF 0 ELSE . ILITERAL THEN ;
  56.  
  57. % RANDOM NUMBER GENRERATOR
  58. % RETURNS AN ODD NUMBER UNIFORMLY DISTRIBUTED BETWEEN 0 AND 65535
  59. 32741 'SEED VARIABLE
  60. 'RAND CODE<  SEED LHLD,  16345 D LXI,  MUL CALL,  XCHG,  SEED SHLD,
  61.   PUSH JMP,  >
  62.  
  63. % WORDS TO HANDLE VARIABLE NUMBER OF ARGUMENTS
  64. % [ ... ]
  65. % LEAVES AT TOP, THE NUMBER OF STACK ENTRIES PUSHED BETWEEN BRACKETS
  66. '[ : S@ <L ;
  67. '] : S@ L> SWAP - 2/ ;
  68.  
  69. % CASE W0 W1 ... WN THEN
  70. % ACCEPTS AN ARGUMENT, I, FROM THE STACK AND EXECUTES
  71. % THE ITH WORD FOLLOWING "CASE".  CONTROL THEN PASSES
  72. % TO THE WORD FOLLOWING "THEN".  (THE FIRST WORD
  73. % FOLLOWING "CASE" HAS INDEX ZERO)
  74. % "CASE ERROR" GIVEN IF I < 0 OR I > N.
  75. % LITERALS MAY NOT BE USED WITHIN A CASE CLAUSE
  76.  
  77. . "CASE ERROR" S,
  78.  
  79. '(CASE) CODE<  .I LHLD,  H INX,  H INX,  M C MOV,  H INX,  M B MOV,
  80.   H DCX,  H PUSH,  B DAD,  .I SHLD,  D POP,  H POP,  H A MOV,  A ORA,
  81.   IFM,  H INX,  H DAD,  C A MOV,  L SUB,  B A MOV,  H SBB,  IFC,
  82.   D DAD,  M E MOV,  H INX,  M D MOV,  () EXEC 1+ JMP,
  83.   THEN, THEN,  H LXI,  ERROR JMP,  >
  84.  
  85. 'CASE : +CHECK () (CASE) C, C. 0 C, ;  IMMEDIATE
  86.  
  87. RADIX !
  88. ;F
  89.  
  90.  
  91.  
  92. ***EOF***
  93.  
  94.