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 >
Wrap
Text File
|
1984-04-29
|
3KB
|
94 lines
% ***************************************************************************
% ** COPYRIGHT (C) MASSACHUSETTS INSTITUTE OF TECHNOLOGY AND HARVARD **
% ** UNIVERSITY, BIOMEDICAL ENGINEERING CENTER 1977. ALL RIGHTS RESERVED. **
% ***************************************************************************
% MISCELLANEOUS DEFINITIONS
% J. SACHS 3/3/77
RADIX @ OCTAL
% 'VOCABULARY-NAME LIST
% LISTS OUT THE NAMES AND ADDRESSED OF ALL WORDS IN VOCABULARY
0 'COL VARIABLE
'FORMAT : COL @ 4 EQ IF CR COL 0<- ELSE COL @ 1+ 16 U*
TAB COL 1+! THEN ;
'LIST : ADDRESS @@ COL 0<- BEGIN DUP 12 - COUNT 5 MIN TYPE COL @
1+ 16 U* 7 - TAB DUP U= FORMAT 4 - @ DUP EQZ END DROP
CR "END OF LIST" MSG ;
% COMPILE CODE TO PUSH THE ASCII CODE OF THE 1ST CHAR OF THE
% FOLLOWING WORD (PUSHES A NULL IF FOLLOWED BY END OF LINE)
'ASCII : WORD () () C, IF 0 ELSE . 1+ B@ THEN C, ; IMMEDIATE
% SIGNED DUMP MEMORY
% ADDRESS COUNT DUMP
'DUMP : OVER + SWAP DO I <#> TYPE ASCII / TYO SPACE
20 0 DO I 1+ 4 * TAB
I J + ? 2 +LOOP CR 20 +LOOP ;
% UNSIGNED DUMP MEMORY
% ADDRESS COUNT UDUMP
'UDUMP : OVER + SWAP DO I <#> TYPE ASCII / TYO SPACE
20 0 DO I 1+ 4 * TAB
I J + U? 2 +LOOP CR 20 +LOOP ;
% ASCII MEMORY DUMP
% ADDRESS COUNT ADUMP
'CHAR= : DUP 40 LT OVER 137 GT OR IF ASCII < TYO
U<#> TYPE ASCII > TYO ELSE TYO THEN ;
'A= : 400 U/MOD CHAR= CHAR= ;
'A? : @ A= ;
'ADUMP : OVER + SWAP DO I <#> TYPE ASCII / TYO SPACE
20 0 DO I J + A? 2 +LOOP CR 20 +LOOP ;
% ACCEPT A NUMBER FROM THE KEYBOARD
% RETURNS A 0 AT TOP IF NOT A LEGAL NUMBER
% OTHERWISE A -1 AT TOP, NUMBER AT TOP - 1
'ACCEPT : RDLINE WORD IF 0 ELSE . ILITERAL THEN ;
% RANDOM NUMBER GENRERATOR
% RETURNS AN ODD NUMBER UNIFORMLY DISTRIBUTED BETWEEN 0 AND 65535
32741 'SEED VARIABLE
'RAND CODE< SEED LHLD, 16345 D LXI, MUL CALL, XCHG, SEED SHLD,
PUSH JMP, >
% WORDS TO HANDLE VARIABLE NUMBER OF ARGUMENTS
% [ ... ]
% LEAVES AT TOP, THE NUMBER OF STACK ENTRIES PUSHED BETWEEN BRACKETS
'[ : S@ <L ;
'] : S@ L> SWAP - 2/ ;
% CASE W0 W1 ... WN THEN
% ACCEPTS AN ARGUMENT, I, FROM THE STACK AND EXECUTES
% THE ITH WORD FOLLOWING "CASE". CONTROL THEN PASSES
% TO THE WORD FOLLOWING "THEN". (THE FIRST WORD
% FOLLOWING "CASE" HAS INDEX ZERO)
% "CASE ERROR" GIVEN IF I < 0 OR I > N.
% LITERALS MAY NOT BE USED WITHIN A CASE CLAUSE
. "CASE ERROR" S,
'(CASE) CODE< .I LHLD, H INX, H INX, M C MOV, H INX, M B MOV,
H DCX, H PUSH, B DAD, .I SHLD, D POP, H POP, H A MOV, A ORA,
IFM, H INX, H DAD, C A MOV, L SUB, B A MOV, H SBB, IFC,
D DAD, M E MOV, H INX, M D MOV, () EXEC 1+ JMP,
THEN, THEN, H LXI, ERROR JMP, >
'CASE : +CHECK () (CASE) C, C. 0 C, ; IMMEDIATE
RADIX !
;F
***EOF***