2274 lines
37 KiB
Plaintext
2274 lines
37 KiB
Plaintext
|
;-*-Midas-*-
|
|||
|
|
|||
|
Title FORTH - The FORTH Language
|
|||
|
|
|||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|||
|
;;;
|
|||
|
;;; Caution: This FORTH is NOT totally standard.
|
|||
|
;;;
|
|||
|
;;; When FORTH is started up, the file AUTO-LOAD.4TH is searched
|
|||
|
;;; for. If it exists, it is loaded automatically. If not, a
|
|||
|
;;; standard header is printed.
|
|||
|
;;;
|
|||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|||
|
|
|||
|
.DECSAV
|
|||
|
|
|||
|
A=1 ;Used by JSYSs mostly
|
|||
|
B=2
|
|||
|
C=3
|
|||
|
|
|||
|
D=4 ;Used exclusively by colon-compiler (Addr is last word built)
|
|||
|
E=5 ; " " " EVAL (Addr of last word evaluated)
|
|||
|
|
|||
|
U=6 ;# things in FORTH stack
|
|||
|
V=7 ;Args for FORTH stack pushing/popping
|
|||
|
L=10 ;Args for EVAL
|
|||
|
|
|||
|
K=11 ;Kharacter from GETCHR and such
|
|||
|
|
|||
|
T1=12 ;Trashy temporaries - No special purpose
|
|||
|
T2=13
|
|||
|
T3=14
|
|||
|
T4=15
|
|||
|
|
|||
|
S=16 ;FORTH stack pointer
|
|||
|
P=17 ;100% Pure Porpoise stack pointer
|
|||
|
|
|||
|
|
|||
|
Call=PUSHJ P,
|
|||
|
Return=POPJ P,
|
|||
|
|
|||
|
|
|||
|
.PRIIN==100 ;TTY input JFN
|
|||
|
.PRIOU==101 ;TTY output JFN
|
|||
|
|
|||
|
|
|||
|
;;;
|
|||
|
;;; Macros
|
|||
|
;;;
|
|||
|
|
|||
|
|
|||
|
Define TYPE &string
|
|||
|
Hrroi A,[Asciz string]
|
|||
|
PSOUT
|
|||
|
Termin
|
|||
|
|
|||
|
|
|||
|
Define DBP ac
|
|||
|
Add ac,[70000,,0]
|
|||
|
Skipge ac
|
|||
|
Sub ac,[430000,,1]
|
|||
|
Termin
|
|||
|
|
|||
|
|
|||
|
;;;
|
|||
|
;;; Storage
|
|||
|
;;;
|
|||
|
|
|||
|
|
|||
|
Loc 140
|
|||
|
|
|||
|
|
|||
|
Popj1: Aos (P)
|
|||
|
CPopj: Return
|
|||
|
|
|||
|
PDLen==200 ;Porpoise stack
|
|||
|
PDList: -PDLen,,.
|
|||
|
Block PDLen
|
|||
|
|
|||
|
Deep==100. ;FORTH stack
|
|||
|
Stack: -Deep,,.
|
|||
|
Block Deep
|
|||
|
|
|||
|
LogNcs: 1.0 ? 3.0 ? 5.0 ? 7.0 ? 9.0 ? 11.0 ? 13.0 ? 15.0
|
|||
|
|
|||
|
|
|||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|||
|
;;;
|
|||
|
;;; Start of execute-time stuff for structures.
|
|||
|
;;;
|
|||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|||
|
|
|||
|
|
|||
|
DOn==10. ;Maximum depth of DO loop nesting.
|
|||
|
DOc: -1 ;Loop # we're in. -1 means not in.
|
|||
|
DOs: Block DOn
|
|||
|
DOtop: Block DOn ;Upper limit of DO
|
|||
|
DOind: Block DOn ;Loop counter, what you get with I, J, etc
|
|||
|
|
|||
|
IFc: -1
|
|||
|
|
|||
|
UNTILn==10.
|
|||
|
UNTILc: -1
|
|||
|
UNTILs: Block UNTILn
|
|||
|
|
|||
|
WHILEn==10.
|
|||
|
WHILEc: -1
|
|||
|
WHILEs: Block WHILEn
|
|||
|
WHILEe: Block WHILEn
|
|||
|
BEGINp: 0
|
|||
|
|
|||
|
|
|||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|||
|
;;;
|
|||
|
;;; Random flags, variables, constants, etc
|
|||
|
;;;
|
|||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|||
|
|
|||
|
|
|||
|
Level: -1 ;Level of recursion
|
|||
|
Trace: 0
|
|||
|
Base: 10. ;I/O number base
|
|||
|
Echo: -1 ;True if we echo input
|
|||
|
|
|||
|
Width: 0 ;Terminal width
|
|||
|
Term: 0 ;Terminal-type #
|
|||
|
|
|||
|
FName: Block 7 ;Filename (asciz) you're screwing with
|
|||
|
Delim: 0 ;Delimiter for text input stuff
|
|||
|
lsText: 0 ;Length of text read by sText
|
|||
|
Loadp: 0 ;True when input is from a file
|
|||
|
StoNmp: 0 ;Flag returned by StoN: Valid number?
|
|||
|
|
|||
|
Making: 0 ;True when we're in the middle of building a Dictionary entry
|
|||
|
Did: 0 ;True when a DOES> was found after <BUILDS during execution.
|
|||
|
BStart: 0 ;For run-time DOES>... the address it returns.
|
|||
|
|
|||
|
JCall: JSYS
|
|||
|
|
|||
|
|
|||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|||
|
;;;
|
|||
|
;;; <# and #> formatting controls
|
|||
|
;;;
|
|||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|||
|
|
|||
|
|
|||
|
FBufl==6 ;Room for 30. characters
|
|||
|
Format: 0
|
|||
|
FLeft: 0
|
|||
|
FMinus: 0
|
|||
|
FBuffr: Block FBufl
|
|||
|
FBufBP: 0
|
|||
|
|
|||
|
|
|||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|||
|
;;;
|
|||
|
;;; Instructions that are executed in the body of the two
|
|||
|
;;; testing routines, via XCT
|
|||
|
;;;
|
|||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|||
|
|
|||
|
|
|||
|
2Tests: Camn V,(S) ; =
|
|||
|
Came V,(S) ; =_
|
|||
|
Camle V,(S) ; <
|
|||
|
Caml V,(S) ; <=
|
|||
|
Camge V,(S) ; >
|
|||
|
Camg V,(S) ; >=
|
|||
|
|
|||
|
1Tests: Skipn (S) ; 0=
|
|||
|
Skipe (S) ; 0=_
|
|||
|
Skipge (S) ; 0<
|
|||
|
Skipg (S) ; 0<=
|
|||
|
Skiple (S) ; 0>
|
|||
|
Skipl (S) ; 0>=
|
|||
|
|
|||
|
|
|||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|||
|
;;;
|
|||
|
;;; The ASCII strings needed to clear screen and home cursor
|
|||
|
;;; on assorted terminals.
|
|||
|
;;;
|
|||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|||
|
|
|||
|
|
|||
|
Clears: 0 ? 0 ? 0 ? 0 ? 0
|
|||
|
Asciz // ;#5 - DM2500
|
|||
|
Asciz /[2J/ ;#6 - I400
|
|||
|
Asciz // ;#7 - DM1520
|
|||
|
0 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0
|
|||
|
Asciz /HJ/ ;#15 - VT52
|
|||
|
0 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0
|
|||
|
Asciz /v/ ;#24 - V200
|
|||
|
0
|
|||
|
Asciz /E/ ;#26 - H19
|
|||
|
|
|||
|
Homes: 0 ? 0 ? 0 ? 0 ? 0
|
|||
|
Asciz //
|
|||
|
Asciz //
|
|||
|
Asciz //
|
|||
|
0 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0
|
|||
|
Asciz /H/
|
|||
|
0 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0
|
|||
|
Asciz //
|
|||
|
0
|
|||
|
Asciz //
|
|||
|
|
|||
|
|
|||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|||
|
;;;
|
|||
|
;;; Control needed to keep track of nested LOADs and iJFNs
|
|||
|
;;;
|
|||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|||
|
|
|||
|
|
|||
|
MaxLLs: 10
|
|||
|
LLoad: -1
|
|||
|
LiJFNs: Block MaxLLs
|
|||
|
iJFN: .PRIIN
|
|||
|
|
|||
|
|
|||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|||
|
;;;
|
|||
|
;;; All the rubbish used by the input processor
|
|||
|
;;;
|
|||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|||
|
|
|||
|
|
|||
|
IBufln==40 ;Allowing for 160. character input lines
|
|||
|
pInBuf: 0
|
|||
|
InBuf: Block IBufln
|
|||
|
nIchar: 0
|
|||
|
|
|||
|
IStrin: Block 3
|
|||
|
IAddr: 0
|
|||
|
INump: 0
|
|||
|
Inmpos: 0
|
|||
|
NotNum: 0
|
|||
|
IVal: 0
|
|||
|
|
|||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|||
|
;;;
|
|||
|
;;; The Primitive FORTH Dictionary
|
|||
|
;;;
|
|||
|
;;; Entries are like:
|
|||
|
;;;
|
|||
|
;;; +0: NAME 01-05
|
|||
|
;;; +1: NAME 06-10
|
|||
|
;;; +2: NAME 11-15
|
|||
|
;;; +3: LENGTH,,CODE
|
|||
|
;;; +4: STUFF1
|
|||
|
;;; . .
|
|||
|
;;; +n: STUFFi
|
|||
|
;;;
|
|||
|
;;; Where NAME's are ASCII words, LENGTH is the total length
|
|||
|
;;; of this entry, CODE is a pointer to a list of STUFFs that
|
|||
|
;;; will be executed when this word is mentioned, and a STUFF
|
|||
|
;;; is one of:
|
|||
|
;;;
|
|||
|
;;; -1 ? CONSTANT
|
|||
|
;;; -1,,SUBROUTINE
|
|||
|
;;; 0,,DICTIONARY
|
|||
|
;;;
|
|||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|||
|
|
|||
|
DPage==10 ;Page to load Dictionary into
|
|||
|
|
|||
|
Foo: Loc DPage*2000
|
|||
|
|
|||
|
Dict: Ascii /DUP/ ? 0 ? 0 ? 5,,0 ? -1,,Dup
|
|||
|
Ascii /SWAP/ ? 0 ? 0 ? 5,,0 ? -1,,Swap
|
|||
|
Ascii /ROLL/ ? 0 ? 0 ? 5,,0 ? -1,,Roll
|
|||
|
Ascii /PICK/ ? 0 ? 0 ? 5,,0 ? -1,,Pick
|
|||
|
Ascii /DROP/ ? 0 ? 0 ? 5,,0 ? -1,,Drop
|
|||
|
Ascii /OVER/ ? 0 ? 0 ? 5,,0 ? -1,,Over
|
|||
|
Ascii /ROT/ ? 0 ? 0 ? 5,,0 ? -1,,Rotate
|
|||
|
Ascii /-DUP/ ? 0 ? 0 ? 5,,0 ? -1,,NZDup
|
|||
|
Ascii /?DUP/ ? 0 ? 0 ? 5,,0 ? -1,,NZDup
|
|||
|
Ascii /LEVEL/ ? 0 ? 0 ? 5,,0 ? -1,,PLevel
|
|||
|
Ascii /DEPTH/ ? 0 ? 0 ? 5,,0 ? -1,,Depth
|
|||
|
Ascii /FLOAT/ ? 0 ? 0 ? 5,,0 ? -1,,ItoF
|
|||
|
Ascii /+/ ? 0 ? 0 ? 5,,0 ? -1,,Plus
|
|||
|
Ascii /-/ ? 0 ? 0 ? 5,,0 ? -1,,Minus
|
|||
|
Ascii /*/ ? 0 ? 0 ? 5,,0 ? -1,,Times
|
|||
|
Ascii "/" ? 0 ? 0 ? 5,,0 ? -1,,Divide
|
|||
|
Ascii /^/ ? 0 ? 0 ? 5,,0 ? -1,,Power
|
|||
|
Ascii /F+/ ? 0 ? 0 ? 5,,0 ? -1,,FPlus
|
|||
|
Ascii /F-/ ? 0 ? 0 ? 5,,0 ? -1,,FMin
|
|||
|
Ascii /F*/ ? 0 ? 0 ? 5,,0 ? -1,,FTimes
|
|||
|
Ascii "F/" ? 0 ? 0 ? 5,,0 ? -1,,FDiv
|
|||
|
Ascii /FIX/ ? 0 ? 0 ? 5,,0 ? -1,,FtoI
|
|||
|
Ascii /MOD/ ? 0 ? 0 ? 5,,0 ? -1,,Mod
|
|||
|
Ascii "/MOD" ? 0 ? 0 ? 5,,0 ? -1,,DivMod
|
|||
|
Ascii /0=/ ? 0 ? 0 ? 5,,0 ? -1,,EqualZ
|
|||
|
Ascii /0=_/ ? 0 ? 0 ? 5,,0 ? -1,,NotEq0
|
|||
|
Ascii /0</ ? 0 ? 0 ? 5,,0 ? -1,,LessZ
|
|||
|
Ascii /0<=/ ? 0 ? 0 ? 5,,0 ? -1,,LesEq0
|
|||
|
Ascii /0>/ ? 0 ? 0 ? 5,,0 ? -1,,GreatZ
|
|||
|
Ascii /0>=/ ? 0 ? 0 ? 5,,0 ? -1,,GrEq0
|
|||
|
Ascii /EXCHANGE/ ? 0 ? 5,,0 ? -1,,XChanj
|
|||
|
Ascii /JSYS/ ? 0 ? 0 ? 5,,0 ? -1,,JSys0
|
|||
|
Ascii /=/ ? 0 ? 0 ? 5,,0 ? -1,,Equal
|
|||
|
Ascii /=_/ ? 0 ? 0 ? 5,,0 ? -1,,NotEqu
|
|||
|
Ascii /</ ? 0 ? 0 ? 5,,0 ? -1,,Less
|
|||
|
Ascii /<=/ ? 0 ? 0 ? 5,,0 ? -1,,LessEq
|
|||
|
Ascii />/ ? 0 ? 0 ? 5,,0 ? -1,,Greatr
|
|||
|
Ascii />=/ ? 0 ? 0 ? 5,,0 ? -1,,GretEq
|
|||
|
Ascii /FLUSH/ ? 0 ? 0 ? 5,,0 ? -1,,Flush
|
|||
|
Ascii /TRACE/ ? 0 ? 0 ? 5,,0 ? -1,,CTrace
|
|||
|
Ascii /@/ ? 0 ? 0 ? 5,,0 ? -1,,Fetch
|
|||
|
Ascii /!/ ? 0 ? 0 ? 5,,0 ? -1,,Store
|
|||
|
Ascii /+!/ ? 0 ? 0 ? 5,,0 ? -1,,Storep
|
|||
|
Ascii /-!/ ? 0 ? 0 ? 5,,0 ? -1,,Storem
|
|||
|
Ascii /FILL/ ? 0 ? 0 ? 5,,0 ? -1,,Fill
|
|||
|
Ascii /'/ ? 0 ? 0 ? 5,,0 ? -1,,Tic
|
|||
|
Ascii /'#/ ? 0 ? 0 ? 5,,0 ? -1,,Ticnum
|
|||
|
Ascii "]" ? 0 ? 0 ? 5,,0 ? -1,,Ticome
|
|||
|
Ascii /QUIT/ ? 0 ? 0 ? 5,,0 ? -1,,Exit
|
|||
|
Ascii "<#" ? 0 ? 0 ? 5,,0 ? -1,,SOutF
|
|||
|
Ascii "#" ? 0 ? 0 ? 5,,0 ? -1,,FDigit
|
|||
|
Ascii /HOLD/ ? 0 ? 0 ? 5,,0 ? -1,,FHold
|
|||
|
Ascii "#N" ? 0 ? 0 ? 5,,0 ? -1,,FNDigs
|
|||
|
Ascii /SIGN/ ? 0 ? 0 ? 5,,0 ? -1,,FSign
|
|||
|
Ascii "#S" ? 0 ? 0 ? 5,,0 ? -1,,FDigs
|
|||
|
Ascii "#>" ? 0 ? 0 ? 5,,0 ? -1,,EOutF
|
|||
|
Ascii /HOME/ ? 0 ? 0 ? 5,,0 ? -1,,Home
|
|||
|
Ascii /CR/ ? 0 ? 0 ? 5,,0 ? -1,,Terpri
|
|||
|
Ascii /CLEAR/ ? 0 ? 0 ? 5,,0 ? -1,,CLS
|
|||
|
Ascii /SPACE/ ? 0 ? 0 ? 5,,0 ? -1,,Space
|
|||
|
Ascii /SPACES/ ? 0 ? 5,,0 ? -1,,Spaces
|
|||
|
Ascii /EMIT/ ? 0 ? 0 ? 5,,0 ? -1,,Emit
|
|||
|
Ascii /TYPE/ ? 0 ? 0 ? 5,,0 ? -1,,7TypeN
|
|||
|
Ascii "[TYPE]" ? 0 ? 5,,0 ? -1,,7Type
|
|||
|
Ascii /KEY/ ? 0 ? 0 ? 5,,0 ? -1,,Key
|
|||
|
Ascii /?TERMINAL/ ? 0 ? 5,,0 ? -1,,Inputp
|
|||
|
Ascii /EXPECT/ ? 0 ? 5,,0 ? -1,,ExpecN
|
|||
|
Ascii "[EXPECT]" ? 0 ? 5,,0 ? -1,,Expect
|
|||
|
Ascii /C@/ ? 0 ? 0 ? 5,,0 ? -1,,CFetch
|
|||
|
Ascii /C!/ ? 0 ? 0 ? 5,,0 ? -1,,CStore
|
|||
|
Ascii /C>/ ? 0 ? 0 ? 5,,0 ? -1,,CPlus
|
|||
|
Ascii /C</ ? 0 ? 0 ? 5,,0 ? -1,,CMinus
|
|||
|
Ascii /./ ? 0 ? 0 ? 5,,0 ? -1,,Dot
|
|||
|
Ascii /.R/ ? 0 ? 0 ? 5,,0 ? -1,,DotR
|
|||
|
Ascii /F./ ? 0 ? 0 ? 5,,0 ? -1,,FDot
|
|||
|
DOTQa=.
|
|||
|
Ascii /."/ ? 0 ? 0 ? 5,,0 ? -1,,Dotext
|
|||
|
Ascii /:"/ ? 0 ? 0 ? 5,,0 ? -1,,ColTex
|
|||
|
Ascii /(")/ ? 0 ? 0 ? 5,,0 ? -1,,SaveTd
|
|||
|
Ascii /["]/ ? 0 ? 0 ? 5,,0 ? -1,,SaveTs
|
|||
|
Ascii /VLIST/ ? 0 ? 0 ? 5,,0 ? -1,,Vlist
|
|||
|
PARENa=.
|
|||
|
Ascii "(" ? 0 ? 0 ? 5,,0 ? -1,,Remark
|
|||
|
Ascii /ABS/ ? 0 ? 0 ? 5,,0 ? -1,,Abs
|
|||
|
Ascii /MINUS/ ? 0 ? 0 ? 5,,0 ? -1,,Negate
|
|||
|
Ascii /+-/ ? 0 ? 0 ? 5,,0 ? -1,,ApSign
|
|||
|
Ascii /1+/ ? 0 ? 0 ? 5,,0 ? -1,,Plus1
|
|||
|
Ascii /1-/ ? 0 ? 0 ? 5,,0 ? -1,,Minus1
|
|||
|
Ascii /MAX/ ? 0 ? 0 ? 5,,0 ? -1,,Max
|
|||
|
Ascii /MIN/ ? 0 ? 0 ? 5,,0 ? -1,,Min
|
|||
|
Ascii /SINE/ ? 0 ? 0 ? 5,,0 ? -1,,Sine
|
|||
|
Ascii /COSINE/ ? 0 ? 5,,0 ? -1,,Cosine
|
|||
|
Ascii /ROOT/ ? 0 ? 0 ? 5,,0 ? -1,,Root
|
|||
|
Ascii /LN/ ? 0 ? 0 ? 5,,0 ? -1,,LogN
|
|||
|
Ascii /<-,,/ ? 0 ? 0 ? 5,,0 ? -1,,LHalf
|
|||
|
Ascii /SW,,AP/ ? 0 ? 5,,0 ? -1,,SHalfs
|
|||
|
Ascii /,,->/ ? 0 ? 0 ? 5,,0 ? -1,,RHalf
|
|||
|
Ascii /AND/ ? 0 ? 0 ? 5,,0 ? -1,,LogAND
|
|||
|
Ascii /OR/ ? 0 ? 0 ? 5,,0 ? -1,,LogOR
|
|||
|
Ascii /NOT/ ? 0 ? 0 ? 5,,0 ? -1,,LogNOT
|
|||
|
Ascii /XOR/ ? 0 ? 0 ? 5,,0 ? -1,,LogXOR
|
|||
|
Ascii /EXECUTE/ ? 0 ? 5,,0 ? -1,,Execut
|
|||
|
Ascii /FORGET/ ? 0 ? 5,,0 ? -1,,Forget
|
|||
|
Ascii /:/ ? 0 ? 0 ? 5,,0 ? -1,,Colon
|
|||
|
SEMIa=.
|
|||
|
Ascii /;/ ? 0 ? 0 ? 5,,0 ? -1,,Buierr
|
|||
|
Ascii /<BUILDS/ ? 0 ? 5,,0 ? -1,,Builds
|
|||
|
DOESa=.
|
|||
|
Ascii /DOES>/ ? 0 ? 0 ? 5,,0 ? -1,,Does
|
|||
|
Ascii /,/ ? 0 ? 0 ? 5,,0 ? -1,,Comma
|
|||
|
Ascii /ALLOT/ ? 0 ? 0 ? 5,,0 ? -1,,Allot
|
|||
|
LOADa=.
|
|||
|
Ascii /LOAD/ ? 0 ? 0 ? 5,,0 ? -1,,Load
|
|||
|
Ascii "[LOAD]" ? 0 ? 5,,0 ? -1,,Loads
|
|||
|
Ascii /UNLOAD/ ? 0 ? 5,,0 ? -1,,Unload
|
|||
|
Ascii /DECIMAL/ ? 0 ? 5,,0 ? -1,,Base10
|
|||
|
Ascii /OCTAL/ ? 0 ? 0 ? 5,,0 ? -1,,Base8
|
|||
|
Ascii /BINARY/ ? 0 ? 5,,0 ? -1,,Base2
|
|||
|
|
|||
|
IFa=.
|
|||
|
Ascii /IF/ ? 0 ? 0 ? 5,,-1 ? -1,,If
|
|||
|
ELSEa=.
|
|||
|
Ascii /ELSE/ ? 0 ? 0 ? 5,,-1 ? -1,,Else
|
|||
|
THENa=.
|
|||
|
Ascii /THEN/ ? 0 ? 0 ? 5,,-1 ? -1,,Then
|
|||
|
|
|||
|
DOa=.
|
|||
|
Ascii /DO/ ? 0 ? 0 ? 5,,-1 ? -1,,DoLoop
|
|||
|
LOOPa=.
|
|||
|
Ascii /LOOP/ ? 0 ? 0 ? 5,,-1 ? -1,,Loop
|
|||
|
LOOPPa=.
|
|||
|
Ascii /+LOOP/ ? 0 ? 0 ? 5,,-1 ? -1,,Loopp
|
|||
|
|
|||
|
Ascii /I/ ? 0 ? 0 ? 5,,0 ? -1,,Aye
|
|||
|
Ascii /J/ ? 0 ? 0 ? 5,,0 ? -1,,Jay
|
|||
|
Ascii /IJ..N/ ? 0 ? 0 ? 5,,0 ? -1,,En
|
|||
|
Ascii /RUNT/ ? 0 ? 0 ? 5,,0 ? -1,,Runt
|
|||
|
|
|||
|
REPTa=.
|
|||
|
Ascii /REPEAT/ ? 0 ? 5,,-1 ? -1,,Rept
|
|||
|
UNTILa=.
|
|||
|
Ascii /UNTIL/ ? 0 ? 0 ? 5,,-1 ? -1,,Until
|
|||
|
|
|||
|
Ascii /CMOVE/ ? 0 ? 0 ? 5,,0 ? -1,,CMoveN
|
|||
|
Ascii "[CMOVE]" ? 0 ? 5,,0 ? -1,,CMoves
|
|||
|
Ascii /HERE/ ? 0 ? 0 ? 5,,0 ? -1,,Here
|
|||
|
Ascii /LEAVE/ ? 0 ? 0 ? 5,,0 ? -1,,Leave
|
|||
|
Ascii /ERROR/ ? 0 ? 0 ? 5,,0 ? -1,,Erret
|
|||
|
Ascii "[NUMBER]" ? 0 ? 5,,0 ? -1,,Number
|
|||
|
|
|||
|
WHILEa=.
|
|||
|
Ascii /WHILE/ ? 0 ? 0 ? 5,,-1 ? -1,,While
|
|||
|
BEGINa=.
|
|||
|
Ascii /BEGIN/ ? 0 ? 0 ? 5,,-1 ? -1,,Begin
|
|||
|
ENDa=.
|
|||
|
Ascii /END/ ? 0 ? 0 ? 5,,-1 ? -1,,FEnd
|
|||
|
|
|||
|
Bottom: 0
|
|||
|
|
|||
|
Loc Foo
|
|||
|
|
|||
|
Dicte: D,,Bottom
|
|||
|
|
|||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|||
|
;;; ;;;
|
|||
|
;;; ;;;
|
|||
|
;;; ;;;
|
|||
|
;;; Start of Executable Part of FORTH ;;;
|
|||
|
;;; ;;;
|
|||
|
;;; ;;;
|
|||
|
;;; ;;;
|
|||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|||
|
|
|||
|
Start: Move P,PDList
|
|||
|
Move S,Stack
|
|||
|
Movei A,.PRIOU
|
|||
|
GTTYP
|
|||
|
Movem B,Term
|
|||
|
Movei A,.PRIIN
|
|||
|
RFMOD
|
|||
|
Trz B,TT%DAM
|
|||
|
Tlz B,TT%ECO
|
|||
|
SFMOD
|
|||
|
Movei B,.MORLW
|
|||
|
MTOPR
|
|||
|
Movem C,Width
|
|||
|
|
|||
|
Initp: Movsi A,(GJ%SHT\GJ%OLD)
|
|||
|
Hrroi B,[Asciz /AUTO-LOAD.4TH/]
|
|||
|
GTJFN
|
|||
|
Jrst Greet
|
|||
|
Move B,[070000,,OF%RD]
|
|||
|
OPENF
|
|||
|
Jrst Greet
|
|||
|
Call LSave
|
|||
|
Jrst PRun
|
|||
|
|
|||
|
Greet: Type "FORTH-10 Type QUIT to exit."
|
|||
|
Call Terpri
|
|||
|
|
|||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|||
|
;;; ;;;
|
|||
|
;;; ;;;
|
|||
|
;;; ;;;
|
|||
|
;;; Top Level of FORTH ;;;
|
|||
|
;;; ;;;
|
|||
|
;;; ;;;
|
|||
|
;;; ;;;
|
|||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|||
|
|
|||
|
PPPRun: Skipn Echo
|
|||
|
Jrst PRun
|
|||
|
Type " Ok"
|
|||
|
PPRun: Call Terpri
|
|||
|
PRun: Call FillIB
|
|||
|
Run: Call Getwrd
|
|||
|
Jrst PPPRun
|
|||
|
Skipe INump
|
|||
|
Jrst [Move V,IVal ;Constants are pushed,
|
|||
|
Call 4SAVE
|
|||
|
Jrst Run]
|
|||
|
Skipn IAddr
|
|||
|
Jrst NamErr
|
|||
|
Move L,IAddr
|
|||
|
Hrre A,3(L)
|
|||
|
Skipg A ;Subroutines executed,
|
|||
|
Move L,4(L)
|
|||
|
Call Eval ;Words evaluated.
|
|||
|
Jrst Run
|
|||
|
|
|||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|||
|
;;; ;;;
|
|||
|
;;; ;;;
|
|||
|
;;; ;;;
|
|||
|
;;; Primitives ;;;
|
|||
|
;;; ;;;
|
|||
|
;;; ;;;
|
|||
|
;;; ;;;
|
|||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|||
|
|
|||
|
;;;
|
|||
|
;;; Stack operations
|
|||
|
;;;
|
|||
|
|
|||
|
Dup: Jumpe U,UFlow ; DUP
|
|||
|
Move V,(S)
|
|||
|
Call 4SAVE
|
|||
|
Return
|
|||
|
|
|||
|
Drop: Call 4REST ; DROP
|
|||
|
Return
|
|||
|
|
|||
|
Over: Caige U,2 ; OVER
|
|||
|
Jrst UFlow
|
|||
|
Move V,-1(S)
|
|||
|
Call 4SAVE
|
|||
|
Return
|
|||
|
|
|||
|
Rotate: Caige U,3 ; ROT
|
|||
|
Jrst UFlow
|
|||
|
Move T1,(S)
|
|||
|
Exch T1,-1(S)
|
|||
|
Exch T1,-2(S)
|
|||
|
Movem T1,(S)
|
|||
|
Return
|
|||
|
|
|||
|
Swap: Caige U,2 ; SWAP
|
|||
|
Jrst UFlow
|
|||
|
Move T1,(S)
|
|||
|
Exch T1,-1(S)
|
|||
|
Movem T1,(S)
|
|||
|
Return
|
|||
|
|
|||
|
Roll: Call 4REST ; ROLL
|
|||
|
Camle V,U
|
|||
|
Jrst UFlow
|
|||
|
Hrrz T1,S
|
|||
|
Sub T1,V
|
|||
|
Move T2,1(T1)
|
|||
|
Movei T3,1(T1)
|
|||
|
Hrli T3,2(T1)
|
|||
|
BLT T3,-1(S)
|
|||
|
Movem T2,(S)
|
|||
|
Return
|
|||
|
|
|||
|
Pick: Call 4REST ; PICK
|
|||
|
Camle V,U
|
|||
|
Jrst UFlow
|
|||
|
Hrrz T1,S
|
|||
|
Sub T1,V
|
|||
|
Move V,1(T1)
|
|||
|
Call 4SAVE
|
|||
|
Return
|
|||
|
|
|||
|
NZDup: Jumpe U,UFlow ; -DUP and ?DUP
|
|||
|
Skipn (S)
|
|||
|
Return
|
|||
|
Move V,(S)
|
|||
|
Call 4SAVE
|
|||
|
Return
|
|||
|
|
|||
|
;;;
|
|||
|
;;; Numeric changes
|
|||
|
;;;
|
|||
|
|
|||
|
Negate: Jumpe U,UFlow ; MINUS
|
|||
|
Movns (S)
|
|||
|
Return
|
|||
|
|
|||
|
RHalf: Jumpe U,UFlow ; ,,->
|
|||
|
Hrre A,(S)
|
|||
|
Movem A,(S)
|
|||
|
Return
|
|||
|
|
|||
|
LHalf: Jumpe U,UFlow ; <-,,
|
|||
|
Hlre A,(S)
|
|||
|
Movem A,(S)
|
|||
|
Return
|
|||
|
|
|||
|
SHalfs: Jumpe U,UFlow ; SW,,AP
|
|||
|
Movss (S)
|
|||
|
Return
|
|||
|
|
|||
|
ApSign: Call 4REST ; +-
|
|||
|
Jumpe U,UFlow
|
|||
|
Skipge V
|
|||
|
Movns (S)
|
|||
|
Return
|
|||
|
|
|||
|
Min: Caige U,2 ; MIN
|
|||
|
Jrst UFlow
|
|||
|
Call 4REST
|
|||
|
Camge V,(S)
|
|||
|
Movem V,(S)
|
|||
|
Return
|
|||
|
|
|||
|
Max: Caige U,2 ; MAX
|
|||
|
Jrst UFlow
|
|||
|
Call 4REST
|
|||
|
Camle V,(S)
|
|||
|
Movem V,(S)
|
|||
|
Return
|
|||
|
|
|||
|
Abs: Jumpe U,UFlow ; ABS
|
|||
|
Movms (S)
|
|||
|
Return
|
|||
|
|
|||
|
Plus1: Jumpe U,UFlow ; 1+
|
|||
|
Aos (S)
|
|||
|
Return
|
|||
|
|
|||
|
Minus1: Jumpe U,UFlow ; 1-
|
|||
|
Sos (S)
|
|||
|
Return
|
|||
|
|
|||
|
;;;
|
|||
|
;;; Floating-point functions
|
|||
|
;;;
|
|||
|
|
|||
|
Cosine: Call 4REST ; COSINE
|
|||
|
FADR V,[1.57079632679]
|
|||
|
Skipa
|
|||
|
Sine: Call 4REST ; SINE
|
|||
|
Move A,V
|
|||
|
Call SorC
|
|||
|
Move V,A
|
|||
|
Call 4SAVE
|
|||
|
Return
|
|||
|
|
|||
|
SorC: Movm B,A
|
|||
|
Camg B,[.0001761]
|
|||
|
Return
|
|||
|
FDVRI A,(+9.0)
|
|||
|
Call SorC
|
|||
|
Call .+1
|
|||
|
FMPR B,B
|
|||
|
FSC B,2
|
|||
|
FADRI B,(-3.0)
|
|||
|
FMPRB A,B
|
|||
|
Return
|
|||
|
|
|||
|
Root: Call 4REST ; ROOT
|
|||
|
Jumple V,[Setz V,
|
|||
|
Call 4SAVE
|
|||
|
Return]
|
|||
|
Move T1,V
|
|||
|
FADRI T1,(+1.0)
|
|||
|
FDVRI T1,(+2.0)
|
|||
|
Root1: Move T2,V
|
|||
|
FDVR T2,T1
|
|||
|
FADR T2,T1
|
|||
|
FDVRI T2,(+2.0)
|
|||
|
Move T3,T2
|
|||
|
FSBR T3,T1
|
|||
|
Movms T3
|
|||
|
Camg T3,[.0000001]
|
|||
|
Jrst Root2
|
|||
|
Move T1,T2
|
|||
|
Jrst Root1
|
|||
|
Root2: Move V,T1
|
|||
|
Call 4SAVE
|
|||
|
Return
|
|||
|
|
|||
|
LogN: Call 4REST ; LN
|
|||
|
Jumple V,[Setz V,
|
|||
|
Call 4SAVE
|
|||
|
Return]
|
|||
|
Move T1,V
|
|||
|
FSBRI T1,(+1.0)
|
|||
|
Move T2,V
|
|||
|
FADRI T2,(+1.0)
|
|||
|
FDVR T1,T2
|
|||
|
Move T2,T1
|
|||
|
Move A,T1
|
|||
|
Setzb C,B
|
|||
|
|
|||
|
LogN1: FMPR T2,T1
|
|||
|
FMPR T2,T1
|
|||
|
Move T3,T2
|
|||
|
FDVR T3,LogNcs(C)
|
|||
|
FADR A,T3
|
|||
|
FSBR B,A
|
|||
|
Movms B
|
|||
|
Camg B,[.0000001]
|
|||
|
Jrst LogN2
|
|||
|
Move B,A
|
|||
|
Aoja C,LogN1
|
|||
|
LogN2: FMPRI A,(+2.0)
|
|||
|
Move V,A
|
|||
|
Call 4SAVE
|
|||
|
Return
|
|||
|
|
|||
|
;;;
|
|||
|
;;; System constants and toggles and stuff
|
|||
|
;;;
|
|||
|
|
|||
|
Depth: Move V,U ; DEPTH
|
|||
|
Call 4SAVE
|
|||
|
Return
|
|||
|
|
|||
|
CTrace: Setcmm Trace ; TRACE
|
|||
|
Return
|
|||
|
|
|||
|
Inputp: Setz V, ; ?TERMINAL
|
|||
|
Movei A,.PRIIN
|
|||
|
SIBE
|
|||
|
Seto V,
|
|||
|
Call 4SAVE
|
|||
|
Return
|
|||
|
|
|||
|
PLevel: Move V,Level ; LEVEL
|
|||
|
Call 4SAVE
|
|||
|
Return
|
|||
|
|
|||
|
Runt: Movei A,.FHSLF ; RUNT
|
|||
|
RUNTM
|
|||
|
Move V,A
|
|||
|
Call 4SAVE
|
|||
|
Return
|
|||
|
|
|||
|
Base10: Movei A,10. ; DECIMAL
|
|||
|
Movem A,Base
|
|||
|
Return
|
|||
|
|
|||
|
Base8: Movei A,8. ; OCTAL
|
|||
|
Movem A,Base
|
|||
|
Return
|
|||
|
|
|||
|
Base2: Movei A,2 ; BINARY
|
|||
|
Movem A,Base
|
|||
|
Return
|
|||
|
|
|||
|
Aye: Skipge DOc ; I
|
|||
|
Jrst DOerr
|
|||
|
Move T1,DOc
|
|||
|
Move V,DOind(T1)
|
|||
|
Call 4SAVE
|
|||
|
Return
|
|||
|
|
|||
|
Jay: Skipg DOc ; J
|
|||
|
Jrst DOerr
|
|||
|
Move T1,DOc
|
|||
|
Soj T1,
|
|||
|
Move V,DOind(T1)
|
|||
|
Call 4SAVE
|
|||
|
Return
|
|||
|
|
|||
|
En: Call 4REST ; IJ..N
|
|||
|
Jumple V,[Type " ?Loop # <1"
|
|||
|
Jrst Erret]
|
|||
|
Soj V,
|
|||
|
Camle V,DOc
|
|||
|
Jrst DOerr
|
|||
|
Move T1,DOc
|
|||
|
Sub T1,V
|
|||
|
Move V,DOind(T1)
|
|||
|
Call 4SAVE
|
|||
|
Return
|
|||
|
|
|||
|
VLIST: Movei T1,Dict
|
|||
|
Setz T2,
|
|||
|
Call Terpri
|
|||
|
VL2: Skipn (T1)
|
|||
|
Return
|
|||
|
Move T3,[440700,,(T1)]
|
|||
|
Setz T4,
|
|||
|
VL3: Ildb A,T3
|
|||
|
Skipe A
|
|||
|
Aoja T4,VL3
|
|||
|
Add T2,T4
|
|||
|
Addi T2,2
|
|||
|
Caml T2,Width
|
|||
|
Jrst [Call Terpri
|
|||
|
Move T2,T4
|
|||
|
Addi T2,2
|
|||
|
Jrst .+1]
|
|||
|
Movei A,40
|
|||
|
PBOUT
|
|||
|
PBOUT
|
|||
|
Move T3,[440700,,(T1)]
|
|||
|
VL4: Ildb A,T3
|
|||
|
PBOUT
|
|||
|
Sojn T4,VL4
|
|||
|
|
|||
|
VL5: Hlrz T3,3(T1)
|
|||
|
Add T1,T3
|
|||
|
Jrst VL2
|
|||
|
|
|||
|
;;;
|
|||
|
;;; Formatted number output stuff
|
|||
|
;;;
|
|||
|
|
|||
|
SOutF: Skipe Format ; <#
|
|||
|
Jrst [Type " ?Already formatting"
|
|||
|
Jrst Erret]
|
|||
|
Jumpe U,UFlow
|
|||
|
Move V,(S)
|
|||
|
Setom Format
|
|||
|
Jumpge V,SOutFs
|
|||
|
Movns V
|
|||
|
Setom FMinus
|
|||
|
SOutFs: Movem V,(S)
|
|||
|
Move A,[010700,,FBufBP-1]
|
|||
|
Movem A,FBufBP
|
|||
|
Movei B,5*FBufl-1
|
|||
|
Movem B,FLeft
|
|||
|
Return
|
|||
|
|
|||
|
FSign: Skipn Format ; SIGN
|
|||
|
Jrst NForm
|
|||
|
Skipn FMinus
|
|||
|
Return
|
|||
|
Movei K,"-
|
|||
|
Call FSave
|
|||
|
Return
|
|||
|
|
|||
|
FDigit: Skipn Format ; #
|
|||
|
Jrst NForm
|
|||
|
Jumpe U,Unform
|
|||
|
Move T1,(S)
|
|||
|
Idiv T1,Base
|
|||
|
Move K,T2
|
|||
|
Addi K,60
|
|||
|
Call FSave
|
|||
|
Movem T1,(S)
|
|||
|
Return
|
|||
|
|
|||
|
FNDigs: Skipn Format ; #N
|
|||
|
Jrst NForm
|
|||
|
Call 4REST
|
|||
|
Skipg V
|
|||
|
Return
|
|||
|
Jumpe U,Unform
|
|||
|
Move T1,(S)
|
|||
|
FNDlop: Idiv T1,Base
|
|||
|
Move K,T2
|
|||
|
Addi K,60
|
|||
|
Call FSave
|
|||
|
Sojn V,FNDlop
|
|||
|
Movem T1,(S)
|
|||
|
Return
|
|||
|
|
|||
|
FHold: Skipn Format ; HOLD
|
|||
|
Jrst NForm
|
|||
|
Call 4REST
|
|||
|
Move K,V
|
|||
|
Call FSave
|
|||
|
Return
|
|||
|
|
|||
|
FDigs: Skipn Format ; #S
|
|||
|
Jrst NForm
|
|||
|
Jumpe U,Unform
|
|||
|
Move T1,(S)
|
|||
|
FDigsl: Jumpe T1,FDigse
|
|||
|
Idiv T1,Base
|
|||
|
Move K,T2
|
|||
|
Addi K,60
|
|||
|
Call FSave
|
|||
|
Jrst FDigsl
|
|||
|
FDigse: Setzm (S)
|
|||
|
Return
|
|||
|
|
|||
|
EOutF: Skipn Format ; #>
|
|||
|
Jrst NForm
|
|||
|
Call 4REST
|
|||
|
Move V,FBufBP
|
|||
|
Call 4SAVE
|
|||
|
Movei V,5*FBufl-1
|
|||
|
Sub V,FLeft
|
|||
|
Call 4SAVE
|
|||
|
Setzm Format
|
|||
|
Return
|
|||
|
|
|||
|
FSave: Skipn FLeft
|
|||
|
Jrst [Type " ?Formatting buffer full"
|
|||
|
Jrst Erret]
|
|||
|
Move A,FBufBP
|
|||
|
DBP A
|
|||
|
Movem A,FBufBP
|
|||
|
Dpb K,FBufBP
|
|||
|
Sos FLeft
|
|||
|
Return
|
|||
|
|
|||
|
;;;
|
|||
|
;;; Display hacking
|
|||
|
;;;
|
|||
|
|
|||
|
Home: Skipn Term ; HOME
|
|||
|
Return
|
|||
|
Move T1,Term
|
|||
|
Move A,[440700,,Homes(T1)]
|
|||
|
PSOUT
|
|||
|
Return
|
|||
|
|
|||
|
CLS: Skipn Term ; CLEAR
|
|||
|
Return
|
|||
|
Move T1,Term
|
|||
|
Move A,[440700,,Clears(T1)]
|
|||
|
PSOUT
|
|||
|
Return
|
|||
|
|
|||
|
;;;
|
|||
|
;;; Outputting words
|
|||
|
;;;
|
|||
|
|
|||
|
Space: Movei A,40 ; SPACE
|
|||
|
PBOUT
|
|||
|
Return
|
|||
|
|
|||
|
Spaces: Call 4REST ; SPACES
|
|||
|
Skipg V
|
|||
|
Return
|
|||
|
Movei A,40
|
|||
|
PBOUT
|
|||
|
Sojn V,.-1
|
|||
|
Return
|
|||
|
|
|||
|
Terpri: Movei A,^M ; CR
|
|||
|
PBOUT
|
|||
|
Movei A,^J
|
|||
|
PBOUT
|
|||
|
Return
|
|||
|
|
|||
|
Emit: Call 4REST ; EMIT
|
|||
|
Move A,V
|
|||
|
PBOUT
|
|||
|
Return
|
|||
|
|
|||
|
7TypeN: Call 4REST ;# Characters TYPE
|
|||
|
Move T1,V
|
|||
|
Call 4REST ;BP
|
|||
|
7TNlop: Ldb A,V
|
|||
|
PBOUT
|
|||
|
Ibp V
|
|||
|
Sojn T1,7TNlop
|
|||
|
Return
|
|||
|
|
|||
|
7Type: Call 4REST ;BP [TYPE]
|
|||
|
7TLoop: Ldb A,V
|
|||
|
Skipn A
|
|||
|
Return
|
|||
|
PBOUT
|
|||
|
Ibp V
|
|||
|
Jrst 7TLoop
|
|||
|
|
|||
|
Dotext: Skiple Level ; ."
|
|||
|
Jrst Dotsav
|
|||
|
Dotxt2: Call Getchr
|
|||
|
Call Refill
|
|||
|
Movem K,Delim
|
|||
|
Dotxt3: Call Getchr
|
|||
|
Call Refill
|
|||
|
Camn K,Delim
|
|||
|
Return
|
|||
|
Move A,K
|
|||
|
PBOUT
|
|||
|
Caie A,^M
|
|||
|
Jrst Dotxt3
|
|||
|
Movei A,^J
|
|||
|
PBOUT
|
|||
|
Jrst Dotxt3
|
|||
|
|
|||
|
Dotsav: Move T1,E
|
|||
|
Hrli T1,440700
|
|||
|
Aoj T1,
|
|||
|
Setz T2,
|
|||
|
|
|||
|
Dots2: Ildb A,T1
|
|||
|
Jumpe A,Dots3
|
|||
|
PBOUT
|
|||
|
Caie A,^M
|
|||
|
Aoja T2,Dots2
|
|||
|
Movei A,^J
|
|||
|
PBOUT
|
|||
|
Aoja T2,Dots2
|
|||
|
|
|||
|
Dots3: Idivi T2,5 ;Return # of text words to skip
|
|||
|
Aoj T2,
|
|||
|
Add E,T2
|
|||
|
Return
|
|||
|
|
|||
|
;;;
|
|||
|
;;; Character operations
|
|||
|
;;;
|
|||
|
|
|||
|
CFetch: Jumpe U,UFlow ; C@
|
|||
|
Ldb A,(S)
|
|||
|
Movem A,(S)
|
|||
|
Return
|
|||
|
|
|||
|
CStore: Call 4REST ;BP C!
|
|||
|
Move T1,V
|
|||
|
Call 4REST ;Byte
|
|||
|
Dpb V,(T1)
|
|||
|
Return
|
|||
|
|
|||
|
CPlus: Call 4REST ;Number C+
|
|||
|
Move T1,V
|
|||
|
Call 4REST ;BP
|
|||
|
Idivi T1,5
|
|||
|
Add V,T1
|
|||
|
Jumpe T2,CPlusb
|
|||
|
Ibp V
|
|||
|
Sojn T2,.-1
|
|||
|
CPlusb: Call 4SAVE
|
|||
|
Return
|
|||
|
|
|||
|
CMinus: Call 4REST ;Number C-
|
|||
|
Move T1,V
|
|||
|
Call 4REST ;BP
|
|||
|
IDivi T1,5
|
|||
|
Sub V,T1
|
|||
|
Jumpe T2,CMin2
|
|||
|
CMin1: Dbp V
|
|||
|
Sojn T2,CMin1
|
|||
|
CMin2: Call 4SAVE
|
|||
|
Return
|
|||
|
|
|||
|
CMoveN: Call 4REST ;Number CMOVE
|
|||
|
Move T1,V
|
|||
|
Call 4REST ;BP-to
|
|||
|
Move T2,V
|
|||
|
Call 4REST ;BP-from
|
|||
|
CMNlop: Ldb A,V
|
|||
|
Dpb A,T2
|
|||
|
Ibp V
|
|||
|
Ibp T2
|
|||
|
Sojn T1,CMNlop
|
|||
|
Return
|
|||
|
|
|||
|
CMoves: Call 4REST ;BP-to [CMOVE] Returns #chars
|
|||
|
Move T1,V
|
|||
|
Call 4REST ;BP-from
|
|||
|
Setz T2,
|
|||
|
CMSlop: Ldb A,V
|
|||
|
Jumpe A,CMSdun
|
|||
|
Dpb A,T1
|
|||
|
Ibp V
|
|||
|
Ibp T1
|
|||
|
Aoja T2,CMSlop
|
|||
|
CMSdun: Call 4SAVE
|
|||
|
Return
|
|||
|
|
|||
|
;;;
|
|||
|
;;; Inputting words
|
|||
|
;;;
|
|||
|
|
|||
|
Key: PBIN ; KEY
|
|||
|
Andi A,177
|
|||
|
Move V,A
|
|||
|
Call 4SAVE
|
|||
|
Return
|
|||
|
|
|||
|
Number: Jumpe U,UFlow ; caddr [NUMBER] --> caddr n -1
|
|||
|
Move T1,(S) ;BP-from ; --> caddr 0
|
|||
|
Call StoN
|
|||
|
Jrst [Movem T1,(S)
|
|||
|
Setz V,
|
|||
|
Call 4SAVE
|
|||
|
Return]
|
|||
|
Movem T1,(S)
|
|||
|
Move V,T2
|
|||
|
Call 4SAVE
|
|||
|
Seto V,
|
|||
|
Call 4SAVE
|
|||
|
Return
|
|||
|
|
|||
|
ExpecN: Call 4REST ;Number EXPECT
|
|||
|
Move T1,V
|
|||
|
Call 4REST ;BP-to
|
|||
|
ENLoop: PBIN
|
|||
|
Dpb A,V
|
|||
|
Skipe Echo
|
|||
|
PBOUT
|
|||
|
Ibp V
|
|||
|
Sojn T1,ENLoop
|
|||
|
Return
|
|||
|
|
|||
|
Expect: Call 4REST ;BP [EXPECT]
|
|||
|
Setz T3,
|
|||
|
ELoop: PBIN
|
|||
|
Cain A,^M
|
|||
|
Jrst ESave
|
|||
|
Dpb A,V
|
|||
|
Skipe Echo
|
|||
|
PBOUT
|
|||
|
Ibp V
|
|||
|
Aoja T3,ELoop
|
|||
|
ESave: Dpb V ;Make it asciz
|
|||
|
Move V,T3
|
|||
|
Call 4SAVE
|
|||
|
Return
|
|||
|
|
|||
|
;;;
|
|||
|
;;; Numberic output
|
|||
|
;;;
|
|||
|
|
|||
|
DotR: Call 4REST ; .R
|
|||
|
Move T4,V
|
|||
|
Skipa
|
|||
|
Dot: Call 4REST ; .
|
|||
|
Dota: Setz T4,
|
|||
|
Movm T1,V
|
|||
|
Setz T3,
|
|||
|
Dot1: IDiv T1,Base
|
|||
|
Push P,T2
|
|||
|
Aoj T3,
|
|||
|
Jumpn T1,Dot1
|
|||
|
Dot2: Move T1,T3
|
|||
|
Skipge V
|
|||
|
Aoj T1,
|
|||
|
Camg T4,T1
|
|||
|
Jrst DotS
|
|||
|
Sub T4,T1
|
|||
|
DotF: Movei A,40
|
|||
|
PBOUT
|
|||
|
Sojn T4,DotF
|
|||
|
DotS: Jumpge V,Dot3
|
|||
|
Movei A,"-
|
|||
|
PBOUT
|
|||
|
Dot3: Pop P,A
|
|||
|
Addi A,60
|
|||
|
PBOUT
|
|||
|
Sojn T3,Dot3
|
|||
|
Dot4: Movei A,40
|
|||
|
PBOUT
|
|||
|
Return
|
|||
|
|
|||
|
FDot: Call 4REST ; F.
|
|||
|
Movei A,.PRIOU
|
|||
|
Move B,V
|
|||
|
Movei C,FL%ONE\FL%PNT
|
|||
|
FLOUT
|
|||
|
Jfcl
|
|||
|
Return
|
|||
|
|
|||
|
;;;
|
|||
|
;;; Text building (Dictionary)
|
|||
|
;;;
|
|||
|
|
|||
|
SaveTs: Call 4REST ; ["]
|
|||
|
Move T1,V
|
|||
|
Movei A,^M
|
|||
|
Movem A,Delim
|
|||
|
Call sTextd
|
|||
|
Move V,T2
|
|||
|
Call 4SAVE
|
|||
|
Return
|
|||
|
|
|||
|
SaveTd: Call 4REST ; (")
|
|||
|
Move T1,V
|
|||
|
Call sText
|
|||
|
Move V,T2
|
|||
|
Call 4SAVE
|
|||
|
Return
|
|||
|
|
|||
|
ColTex: Call BText
|
|||
|
Move V,lsText
|
|||
|
Call 4SAVE
|
|||
|
Return
|
|||
|
|
|||
|
;;;
|
|||
|
;;; Miscellaneous
|
|||
|
;;;
|
|||
|
|
|||
|
Exit: Call Terpri
|
|||
|
Type "Exiting FORTH"
|
|||
|
Call Terpri
|
|||
|
Jrst Die
|
|||
|
|
|||
|
Remark: Call Getchr ; (
|
|||
|
Call Refill
|
|||
|
Caie K,")
|
|||
|
Jrst Remark
|
|||
|
Return
|
|||
|
|
|||
|
Here: Skipn Making ; HERE
|
|||
|
Jrst Buierr
|
|||
|
Move V,Dicte
|
|||
|
Add V,D
|
|||
|
Call 4SAVE
|
|||
|
Return
|
|||
|
|
|||
|
Execut: Call 4REST ; EXECUTE
|
|||
|
Move L,V
|
|||
|
Call Eval
|
|||
|
Return
|
|||
|
|
|||
|
Leave: Skipge DOc
|
|||
|
Jrst DOerr
|
|||
|
Move T1,DOc
|
|||
|
Move T2,DOtop(T1)
|
|||
|
Movem T2,DOind(T1)
|
|||
|
Return
|
|||
|
|
|||
|
Jsys0: Call 4REST ;JSys# JSYS
|
|||
|
Hrr V,JCall
|
|||
|
Xct JCall
|
|||
|
Return
|
|||
|
|
|||
|
Flush: Move S,Stack ; FLUSH
|
|||
|
Setz U,
|
|||
|
Return
|
|||
|
|
|||
|
;;;
|
|||
|
;;; Stack/Memory operations
|
|||
|
;;;
|
|||
|
|
|||
|
Store: Call 4REST ; !
|
|||
|
Move T1,V
|
|||
|
Call 4REST
|
|||
|
Movem V,(T1)
|
|||
|
Return
|
|||
|
|
|||
|
Storep: Call 4REST ; +!
|
|||
|
Move T1,V
|
|||
|
Call 4REST
|
|||
|
Addm V,(T1)
|
|||
|
Return
|
|||
|
|
|||
|
Storem: Call 4REST ; -!
|
|||
|
Move T1,V
|
|||
|
Call 4REST
|
|||
|
Exch V,(T1)
|
|||
|
Subm V,(T1)
|
|||
|
Return
|
|||
|
|
|||
|
Fill: Call 4REST ;Value FILL
|
|||
|
Move T1,V
|
|||
|
Call 4REST ;Number
|
|||
|
Move T2,V
|
|||
|
Call 4REST ;Address
|
|||
|
Add T2,V
|
|||
|
Movem T1,V
|
|||
|
Hrl V,V
|
|||
|
Aoj V,
|
|||
|
BLT V,-1(T2)
|
|||
|
Return
|
|||
|
|
|||
|
XChanj: Call 4REST ; EXCHANGE
|
|||
|
Move T1,V
|
|||
|
Call 4REST
|
|||
|
Move T2,(V)
|
|||
|
Exch T2,(T1)
|
|||
|
Movem T2,(V)
|
|||
|
Return
|
|||
|
|
|||
|
Fetch: Jumpe U,UFlow ; @
|
|||
|
Move T1,(S)
|
|||
|
Move T2,(T1)
|
|||
|
Movem T2,(S)
|
|||
|
Return
|
|||
|
|
|||
|
;;;
|
|||
|
;;; Random Dictionary stuff
|
|||
|
;;;
|
|||
|
|
|||
|
Tic: Call Getwrd ; '
|
|||
|
Call Refill
|
|||
|
Skipn IAddr
|
|||
|
Jrst NamErr
|
|||
|
Move V,IAddr
|
|||
|
Call 4SAVE
|
|||
|
Return
|
|||
|
|
|||
|
Ticnum: Call Getwrd ; '#
|
|||
|
Call Refill
|
|||
|
Skipn INump
|
|||
|
Jrst NamErr
|
|||
|
Move V,IVal
|
|||
|
Call 4SAVE
|
|||
|
Return
|
|||
|
|
|||
|
Forget: Call Getwrd ; FORGET
|
|||
|
Call Refill
|
|||
|
Skipn IAddr
|
|||
|
Jrst NamErr
|
|||
|
Move T1,IAddr
|
|||
|
Setzm (T1)
|
|||
|
Hrl T1,T1
|
|||
|
Aoj T1,
|
|||
|
BLT T1,Dicte
|
|||
|
Move A,IAddr
|
|||
|
Hrrm A,Dicte
|
|||
|
Return
|
|||
|
|
|||
|
;;;
|
|||
|
;;; Logical operations
|
|||
|
;;;
|
|||
|
|
|||
|
LogAND: Caige U,2 ; AND
|
|||
|
Jrst UFlow
|
|||
|
Call 4REST
|
|||
|
Andm V,(S)
|
|||
|
Return
|
|||
|
|
|||
|
LogOR: Caige U,2 ; OR
|
|||
|
Jrst UFlow
|
|||
|
Call 4REST
|
|||
|
IOrm V,(S)
|
|||
|
Return
|
|||
|
|
|||
|
LogNOT: Jumpe U,UFlow ; NOT
|
|||
|
Setcmm (S)
|
|||
|
Return
|
|||
|
|
|||
|
LogXOR: Caige U,2 ; XOR
|
|||
|
Jrst UFlow
|
|||
|
Call 4REST
|
|||
|
XOrm V,(S)
|
|||
|
Return
|
|||
|
|
|||
|
;;;
|
|||
|
;;; Arithmetic operations
|
|||
|
;;;
|
|||
|
|
|||
|
Plus: Caige U,2 ; +
|
|||
|
Jrst UFlow
|
|||
|
Call 4REST
|
|||
|
Addm V,(S)
|
|||
|
Return
|
|||
|
|
|||
|
FPlus: Caige U,2 ; F+
|
|||
|
Jrst UFlow
|
|||
|
Call 4REST
|
|||
|
FADM V,(S)
|
|||
|
Return
|
|||
|
|
|||
|
Minus: Call 4REST ; -
|
|||
|
Jumpe U,UFlow
|
|||
|
Exch V,(S)
|
|||
|
Subm V,(S)
|
|||
|
Return
|
|||
|
|
|||
|
FMin: Call 4REST ; F-
|
|||
|
Jumpe U,UFlow
|
|||
|
Exch V,(S)
|
|||
|
FSBM V,(S)
|
|||
|
Return
|
|||
|
|
|||
|
Times: Caige U,2 ; *
|
|||
|
Jrst UFlow
|
|||
|
Call 4REST
|
|||
|
IMulm V,(S)
|
|||
|
Return
|
|||
|
|
|||
|
FTimes: Caige U,2 ; F*
|
|||
|
Jrst UFlow
|
|||
|
Call 4REST
|
|||
|
FMPM V,(S)
|
|||
|
Return
|
|||
|
|
|||
|
Divide: Call 4REST ; /
|
|||
|
Jumpe U,UFlow
|
|||
|
Exch V,(S)
|
|||
|
IDivm V,(S)
|
|||
|
Return
|
|||
|
|
|||
|
FDiv: Call 4REST ; F/
|
|||
|
Jumpe U,UFlow
|
|||
|
Exch V,(S)
|
|||
|
FDVM V,(S)
|
|||
|
Return
|
|||
|
|
|||
|
Power: Call 4REST ; ^
|
|||
|
Move T1,V
|
|||
|
Call 4REST
|
|||
|
Movei T2,1
|
|||
|
P2: Jumple T1,P3
|
|||
|
Imul T2,V
|
|||
|
Soja T1,P2
|
|||
|
P3: Move V,T2
|
|||
|
Call 4SAVE
|
|||
|
Return
|
|||
|
|
|||
|
Mod: Call 4REST ; MOD
|
|||
|
Move T1,V
|
|||
|
Call 4REST
|
|||
|
Move T2,V
|
|||
|
IDiv T2,T1
|
|||
|
Move V,T3
|
|||
|
Call 4SAVE
|
|||
|
Return
|
|||
|
|
|||
|
DivMod: Call 4REST ; /MOD
|
|||
|
Move T1,V
|
|||
|
Call 4REST
|
|||
|
Move T2,V
|
|||
|
IDiv T2,T1
|
|||
|
Move V,T3
|
|||
|
Call 4SAVE
|
|||
|
Move V,T2
|
|||
|
Call 4SAVE
|
|||
|
Return
|
|||
|
|
|||
|
;;;
|
|||
|
;;; Conversions
|
|||
|
;;;
|
|||
|
|
|||
|
ItoF: Jumpe U,UFlow ; FLOAT
|
|||
|
FLTR T1,(S)
|
|||
|
Movem T1,(S)
|
|||
|
Return
|
|||
|
|
|||
|
FtoI: Jumpe U,UFlow ; FIX
|
|||
|
FIXR T1,(S)
|
|||
|
Movem T1,(S)
|
|||
|
Return
|
|||
|
|
|||
|
;;;
|
|||
|
;;; Single operator tests
|
|||
|
;;;
|
|||
|
|
|||
|
EqualZ: Setz A, ; 0=
|
|||
|
Jrst 1Test
|
|||
|
NotEq0: Movei A,1 ; 0=_
|
|||
|
Jrst 1Test
|
|||
|
LessZ: Movei A,2 ; 0<
|
|||
|
Jrst 1Test
|
|||
|
LesEq0: Movei A,3 ; 0<=
|
|||
|
Jrst 1Test
|
|||
|
GreatZ: Movei A,4 ; 0>
|
|||
|
Jrst 1Test
|
|||
|
GrEq0: Movei A,5 ; 0>=
|
|||
|
|
|||
|
1Test: Jumpe U,UFlow
|
|||
|
Setz T1,
|
|||
|
Xct 1Tests(A)
|
|||
|
Seto T1,
|
|||
|
Movem T1,(S)
|
|||
|
Return
|
|||
|
|
|||
|
;;;
|
|||
|
;;; Two operator tests
|
|||
|
;;;
|
|||
|
|
|||
|
Equal: Setz A, ; =
|
|||
|
Jrst 2Test
|
|||
|
NotEqu: Movei A,1 ; =_
|
|||
|
Jrst 2Test
|
|||
|
Less: Movei A,2 ; <
|
|||
|
Jrst 2Test
|
|||
|
LessEq: Movei A,3 ; <=
|
|||
|
Jrst 2Test
|
|||
|
Greatr: Movei A,4 ; >
|
|||
|
Jrst 2Test
|
|||
|
GretEq: Movei A,5 ; >=
|
|||
|
|
|||
|
2Test: Call 4REST
|
|||
|
Jumpe U,UFlow
|
|||
|
Setz T1,
|
|||
|
Xct 2Tests(A)
|
|||
|
Seto T1,
|
|||
|
Movem T1,(S)
|
|||
|
Return
|
|||
|
|
|||
|
;;;
|
|||
|
;;; File-loading things
|
|||
|
;;;
|
|||
|
|
|||
|
Load: Move T3,LLoad ; LOAD
|
|||
|
Cail T3,MaxLLs
|
|||
|
Jrst [Type " ?Can't load deeper"
|
|||
|
Jrst Erret]
|
|||
|
Skipg Level
|
|||
|
Jrst L2
|
|||
|
Movsi A,(GJ%SHT\GJ%OLD)
|
|||
|
Hrro B,E
|
|||
|
Aoj B,
|
|||
|
GTJFN
|
|||
|
Jrst NoFile
|
|||
|
Hrrz T1,B
|
|||
|
Sub T1,E
|
|||
|
Move B,[070000,,OF%RD]
|
|||
|
OPENF
|
|||
|
Jrst NoFile
|
|||
|
Add E,T1
|
|||
|
Jrst LSave
|
|||
|
|
|||
|
L2: Call Getchr
|
|||
|
Call Refill
|
|||
|
Movem K,Delim
|
|||
|
Move T1,[440700,,FName]
|
|||
|
L3: Call Getchr
|
|||
|
Call Refill
|
|||
|
Camn K,Delim
|
|||
|
Jrst L4
|
|||
|
Idpb K,T1
|
|||
|
Jrst L3
|
|||
|
L4: Idpb T1 ;Make asciz
|
|||
|
Hrroi B,FName
|
|||
|
L5: Movsi A,(GJ%SHT\GJ%OLD)
|
|||
|
GTJFN
|
|||
|
Jrst NoFile
|
|||
|
Move B,[070000,,OF%RD]
|
|||
|
OPENF
|
|||
|
Jrst NoFile
|
|||
|
|
|||
|
LSave: Move T1,iJFN
|
|||
|
Aos T2,LLoad
|
|||
|
Movem T1,LiJFNs(T2)
|
|||
|
Movem A,iJFN
|
|||
|
Setom Loadp
|
|||
|
Setzm Echo
|
|||
|
Return
|
|||
|
|
|||
|
Loads: Call 4REST ; [LOAD]
|
|||
|
Hrro B,V
|
|||
|
Jrst L5
|
|||
|
|
|||
|
Unload: Skipge LLoad ; UNLOAD
|
|||
|
Jrst [Type " ?Not loading"
|
|||
|
Jrst Erret]
|
|||
|
Move A,iJFN
|
|||
|
CLOSF
|
|||
|
Jrst [Type " %Can't close file"
|
|||
|
Jrst .+1]
|
|||
|
Move T1,LLoad
|
|||
|
Move A,LiJFNs(T1)
|
|||
|
Movem A,iJFN
|
|||
|
Sos LLoad
|
|||
|
Skipl LLoad
|
|||
|
Return
|
|||
|
Setom Echo
|
|||
|
Setzm Loadp
|
|||
|
Return
|
|||
|
|
|||
|
;;;
|
|||
|
;;; The infamous IF/ELSE/THEN structure
|
|||
|
;;;
|
|||
|
|
|||
|
IF: Call 4REST
|
|||
|
Skipe V
|
|||
|
Return
|
|||
|
IFskip: Aoj E,
|
|||
|
Move T1,(E)
|
|||
|
Came T1,[-1,,Then]
|
|||
|
Camn T1,[-1,,Else]
|
|||
|
Return
|
|||
|
Jrst IFskip
|
|||
|
|
|||
|
Else: Aoj E,
|
|||
|
Move T1,(E)
|
|||
|
Came T1,[-1,,Then]
|
|||
|
Jrst Else
|
|||
|
Return
|
|||
|
|
|||
|
Then: Return
|
|||
|
|
|||
|
;;;
|
|||
|
;;; The REPEAT/UNTIL loop
|
|||
|
;;;
|
|||
|
|
|||
|
Rept: Aos T1,UNTILc
|
|||
|
Movem E,UNTILs(T1) ;Start of REPEAT code
|
|||
|
Return
|
|||
|
|
|||
|
Until: Call 4REST
|
|||
|
Jumpe V,[Move T1,UNTILc
|
|||
|
Move E,UNTILs(T1)
|
|||
|
Return]
|
|||
|
Sos UNTILc
|
|||
|
Return
|
|||
|
|
|||
|
;;;
|
|||
|
;;; The leading test WHILE/BEGIN/END loop
|
|||
|
;;;
|
|||
|
|
|||
|
While: Aos T1,WHILEc
|
|||
|
Movem E,WHILEs(T1)
|
|||
|
Setzm WHILEe(T1)
|
|||
|
Return
|
|||
|
|
|||
|
Begin: Call 4REST
|
|||
|
Skipe V
|
|||
|
Return
|
|||
|
Move T1,WHILEc
|
|||
|
Skipe WHILEe(T1)
|
|||
|
Jrst [Move E,WHILEe(T1)
|
|||
|
Return]
|
|||
|
Begin2: Aoj E,
|
|||
|
Move T1,(E)
|
|||
|
Came T1,[-1,,FEnd]
|
|||
|
Aoja E,Begin2
|
|||
|
Sos WHILEc
|
|||
|
Return
|
|||
|
|
|||
|
FEnd: Move T1,WHILEc
|
|||
|
Movem E,WHILEe(T1)
|
|||
|
Move E,WHILEs(T1)
|
|||
|
Return
|
|||
|
|
|||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|||
|
;;;
|
|||
|
;;; The obligatory DO/LOOP[+] structure.
|
|||
|
;;;
|
|||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|||
|
|
|||
|
DoLoop: Aos T1,DOc
|
|||
|
Movem E,DOs(T1)
|
|||
|
Call 4REST
|
|||
|
Movem V,DOind(T1) ;Initial value
|
|||
|
Call 4REST
|
|||
|
Movem V,DOtop(T1) ;Upper limit
|
|||
|
Return
|
|||
|
|
|||
|
Loop: Move T1,DOc
|
|||
|
Aos V,DOind(T1)
|
|||
|
Jrst Loopt
|
|||
|
|
|||
|
Loopp: Move T1,DOc
|
|||
|
Call 4REST
|
|||
|
Jumpl V,Looppm
|
|||
|
Addb V,DOind(T1)
|
|||
|
|
|||
|
Loopt: Camge V,DOtop(T1)
|
|||
|
Move E,DOs(T1)
|
|||
|
Caml V,DOtop(T1)
|
|||
|
Sos DOc
|
|||
|
Return
|
|||
|
|
|||
|
Looppm: Addb V,DOtop(T1)
|
|||
|
Camle V,DOtop(T1)
|
|||
|
Move E,DOs(T1)
|
|||
|
Camg V,DOtop(t1)
|
|||
|
Sos DOc
|
|||
|
Return
|
|||
|
|
|||
|
;;;
|
|||
|
;;; The Colon (:) Compiler (Quite Hirsute)
|
|||
|
;;;
|
|||
|
|
|||
|
Colon: Skipe Making
|
|||
|
Jrst [Type " ?Can't compile :'s"
|
|||
|
Jrst Erret]
|
|||
|
Setom Making
|
|||
|
Call MHead
|
|||
|
|
|||
|
Colon1: Call Getwrd
|
|||
|
Call Refill
|
|||
|
Skipe INump
|
|||
|
Jrst [Aoj D,
|
|||
|
Setom @Dicte
|
|||
|
Aoj D,
|
|||
|
Move T1,IVal
|
|||
|
Movem T1,@Dicte
|
|||
|
Jrst Colon1]
|
|||
|
Skipn IAddr
|
|||
|
Jrst [Type " ?Undefined"
|
|||
|
Jrst Erret]
|
|||
|
Move T1,IAddr
|
|||
|
Cain T1,SEMIa
|
|||
|
Jrst Coldun
|
|||
|
Caie T1,PARENa ;Don't compile comments
|
|||
|
Jrst Colon2
|
|||
|
Colsr: Call Getchr
|
|||
|
Call Refill
|
|||
|
Caie K,")
|
|||
|
Jrst Colsr
|
|||
|
|
|||
|
Colon2: Hrre A,3(T1)
|
|||
|
Jumpg A,[Aoj D,
|
|||
|
Movem T1,@Dicte
|
|||
|
Jrst Colon1]
|
|||
|
Caie T1,ELSEa
|
|||
|
Jrst Colon3
|
|||
|
Skipge IFc
|
|||
|
Jrst [Type " ?ELSE without IF"
|
|||
|
Jrst Erret]
|
|||
|
Jrst Colis
|
|||
|
|
|||
|
Colon3: Caie T1,THENa
|
|||
|
Jrst Colon4
|
|||
|
Skipge IFc
|
|||
|
Jrst [Type " ?THEN without IF"
|
|||
|
Jrst Erret]
|
|||
|
Sos IFc
|
|||
|
Jrst Colis
|
|||
|
|
|||
|
Colon4: Caie T1,BEGINa
|
|||
|
Jrst Colon5
|
|||
|
Skipge WHILEc
|
|||
|
Jrst [Type " ?BEGIN without WHILE"
|
|||
|
Jrst Erret]
|
|||
|
Setom BEGINp
|
|||
|
Jrst Colis
|
|||
|
|
|||
|
Colon5: Caie T1,ENDa
|
|||
|
Jrst Colis
|
|||
|
Skipge WHILEc
|
|||
|
Jrst [Type " ?END without WHILE"
|
|||
|
Jrst Erret]
|
|||
|
Skipn BEGINp
|
|||
|
Jrst [Type " ?END without BEGIN"
|
|||
|
Jrst Erret]
|
|||
|
Pop P,BEGINp
|
|||
|
Sos WHILEc
|
|||
|
|
|||
|
Colis: Move T4,4(T1)
|
|||
|
Aoj D,
|
|||
|
Movem T4,@Dicte
|
|||
|
|
|||
|
CLoad: Caie T1,DOTQa
|
|||
|
Cain T1,LOADa
|
|||
|
Jrst [Call BText
|
|||
|
Jrst Colon1]
|
|||
|
|
|||
|
Colis1: Caie T1,UNTILa
|
|||
|
Jrst Colis2
|
|||
|
Skipge UNTILc
|
|||
|
Jrst [Type " ?UNTIL without REPEAT"
|
|||
|
Jrst Erret]
|
|||
|
Sos UNTILc
|
|||
|
Jrst Colon1
|
|||
|
|
|||
|
Colis2: Caie T1,LOOPa
|
|||
|
Cain T1,LOOPPa
|
|||
|
Skipa
|
|||
|
Jrst Colis3
|
|||
|
Skipge DOc
|
|||
|
Jrst [Type " ?LOOP without DO"
|
|||
|
Jrst Erret]
|
|||
|
Sos DOc
|
|||
|
Jrst Colon1
|
|||
|
|
|||
|
Colis3: Caie T1,IFa
|
|||
|
Jrst Colis4
|
|||
|
Aos IFc
|
|||
|
Jrst Colon1
|
|||
|
|
|||
|
Colis4: Caie T1,DOa
|
|||
|
Jrst Colis5
|
|||
|
Move A,DOc
|
|||
|
Cail A,DOn-1
|
|||
|
Jrst [Type " ?DOs nested too deeply"
|
|||
|
Jrst Erret]
|
|||
|
Aos DOc
|
|||
|
Jrst Colon1
|
|||
|
|
|||
|
Colis5: Caie T1,REPTa
|
|||
|
Jrst Colis6
|
|||
|
Move A,UNTILc
|
|||
|
Cail A,UNTILn-1
|
|||
|
Jrst [Type " ?REPEATs nested too deeply"
|
|||
|
Jrst Erret]
|
|||
|
Aos UNTILc
|
|||
|
Jrst Colon1
|
|||
|
|
|||
|
Colis6: Caie T1,WHILEa
|
|||
|
Jrst Colon1
|
|||
|
Move A,WHILEc
|
|||
|
Cail A,WHILEn-1
|
|||
|
Jrst [Type " ?WHILEs nested too deeply"
|
|||
|
Jrst Erret]
|
|||
|
Aos WHILEc
|
|||
|
Push P,BEGINp
|
|||
|
Setzm BEGINp
|
|||
|
Jrst Colon1
|
|||
|
|
|||
|
Coldun: Skipl IFc
|
|||
|
Jrst [Type " ?Unfinished IF"
|
|||
|
Jrst Erret]
|
|||
|
Skipl DOc
|
|||
|
Jrst [Type " ?Unfinished DO"
|
|||
|
Jrst Erret]
|
|||
|
Skipl UNTILc
|
|||
|
Jrst [Type " ?Unfinished REPEAT"
|
|||
|
Jrst Erret]
|
|||
|
Skipl WHILEc
|
|||
|
Jrst [Type " ?Unfinished WHILE"
|
|||
|
Jrst Erret]
|
|||
|
Hrrz T1,Dicte
|
|||
|
Addi T1,4 ;Address of executable part
|
|||
|
Addi D,2
|
|||
|
Hrl T1,D
|
|||
|
Movem T1,-1(T1) ;Length,,Address
|
|||
|
Addm D,Dicte
|
|||
|
Setzm Making
|
|||
|
Return
|
|||
|
|
|||
|
;;;
|
|||
|
;;; Dictionary building words
|
|||
|
;;;
|
|||
|
|
|||
|
Builds: Skipe Making ; <BUILDS
|
|||
|
Jrst [Type " ?Already building"
|
|||
|
Jrst Erret]
|
|||
|
Call MHead
|
|||
|
Setom Making
|
|||
|
Return
|
|||
|
|
|||
|
Does: Skipn Making ; DOES>
|
|||
|
Jrst [Move V,BStart
|
|||
|
Call 4SAVE
|
|||
|
Return]
|
|||
|
Move T1,Dicte
|
|||
|
Move T2,E
|
|||
|
Aoj D,
|
|||
|
Hrl T2,D
|
|||
|
Movem T2,3(T1)
|
|||
|
Addm D,Dicte
|
|||
|
Setzm Making
|
|||
|
Setom Did
|
|||
|
Return
|
|||
|
|
|||
|
Comma: Skipn Making ; ,
|
|||
|
Jrst Buierr
|
|||
|
Call 4REST
|
|||
|
Aoj D,
|
|||
|
Movem V,@Dicte
|
|||
|
Return
|
|||
|
|
|||
|
Allot: Skipn Making ; ALLOT
|
|||
|
Jrst Buierr
|
|||
|
Call 4REST
|
|||
|
Skiple V
|
|||
|
Add D,V
|
|||
|
Return
|
|||
|
|
|||
|
Ticome: Skipn Making ; ] --> n
|
|||
|
Jrst Buierr
|
|||
|
Setz V,
|
|||
|
Ticom2: Call Getwrd
|
|||
|
Call Refill
|
|||
|
Skipe INump
|
|||
|
Jrst Numer
|
|||
|
Skipn IAddr
|
|||
|
Jrst UDef
|
|||
|
Move A,IAddr
|
|||
|
Cain A,SEMIa
|
|||
|
Jrst [Call 4SAVE
|
|||
|
Return]
|
|||
|
Aoj D,
|
|||
|
Movem A,@Dicte
|
|||
|
Aoja V,Ticom2
|
|||
|
|
|||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|||
|
;;; ;;;
|
|||
|
;;; ;;;
|
|||
|
;;; ;;;
|
|||
|
;;; Error Messages and Handling ;;;
|
|||
|
;;; ;;;
|
|||
|
;;; ;;;
|
|||
|
;;; ;;;
|
|||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|||
|
|
|||
|
NoFile: Type " ?Can't access file"
|
|||
|
Jrst Rerun
|
|||
|
|
|||
|
UFlow: Type " ?Stack underflow"
|
|||
|
Jrst Erret
|
|||
|
|
|||
|
OFlow: Type " ?Stack overflow"
|
|||
|
Jrst Erret
|
|||
|
|
|||
|
Buierr: Type " ?Not building"
|
|||
|
Jrst Erret
|
|||
|
|
|||
|
DOerr: Type " ?Loops too shallow"
|
|||
|
Jrst Erret
|
|||
|
|
|||
|
NForm: Type " ?Not formatting"
|
|||
|
Jrst Erret
|
|||
|
|
|||
|
Unform: Type " ?Formatting # gone"
|
|||
|
Setzm Format
|
|||
|
Jrst Erret
|
|||
|
|
|||
|
UDef: Type " ?Undefined word"
|
|||
|
Jrst Erret
|
|||
|
|
|||
|
Numer: Type " ?Numeric word"
|
|||
|
Jrst Erret
|
|||
|
|
|||
|
WMode: Type " ?Immediate use disallowed"
|
|||
|
|
|||
|
Erret: Call Terpri
|
|||
|
Move T1,[440700,,InBuf]
|
|||
|
Move T2,nIchar
|
|||
|
Soj T2,
|
|||
|
Erret2: Ildb A,T1
|
|||
|
PBOUT
|
|||
|
Sojg T2,Erret2
|
|||
|
Erret3: Type "<--"
|
|||
|
|
|||
|
UnMake: Skipn Making
|
|||
|
Jrst ReRun
|
|||
|
Call Terpri
|
|||
|
Type "%Unbuilding"
|
|||
|
Setzm @Dicte
|
|||
|
Sojge D,.-1
|
|||
|
Setzm Making
|
|||
|
|
|||
|
ReRun: Setzm nIchar
|
|||
|
Setom Level
|
|||
|
Setom DOc
|
|||
|
Setom IFc
|
|||
|
Setom WHILEc
|
|||
|
Setom UNTILc
|
|||
|
Move P,PDList
|
|||
|
Skipn Loadp
|
|||
|
Jrst PPRun
|
|||
|
Call Terpri
|
|||
|
Type "%Aborting load"
|
|||
|
Call Unload
|
|||
|
Jrst PPRun
|
|||
|
|
|||
|
NamErr: Movei A,40
|
|||
|
PBOUT
|
|||
|
Hrroi A,IStrin
|
|||
|
PSOUT
|
|||
|
Movei A,"?
|
|||
|
PBOUT
|
|||
|
Movei A,40
|
|||
|
PBOUT
|
|||
|
Jrst ReRun
|
|||
|
|
|||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|||
|
;;; ;;;
|
|||
|
;;; ;;;
|
|||
|
;;; ;;;
|
|||
|
;;; Subroutines ;;;
|
|||
|
;;; ;;;
|
|||
|
;;; ;;;
|
|||
|
;;; ;;;
|
|||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|||
|
|
|||
|
4SAVE: Cail U,Deep
|
|||
|
Jrst OFlow
|
|||
|
Aoj U,
|
|||
|
Push S,V
|
|||
|
Return
|
|||
|
|
|||
|
4REST: Jumpe U,UFlow
|
|||
|
Soj U,
|
|||
|
Pop S,V
|
|||
|
Return
|
|||
|
|
|||
|
Getchr: Ildb K,pInBuf ;Returns one character in K. Skips
|
|||
|
Skipn K ;if there's something to get.
|
|||
|
Return
|
|||
|
Aos nIchar
|
|||
|
Jrst Popj1
|
|||
|
|
|||
|
Refill: Skipe Echo ;Does a fill-input-buffer and returns
|
|||
|
Call Terpri ;to the instruction BEFORE the call.
|
|||
|
Call FillIB
|
|||
|
Sos (P)
|
|||
|
Sos (P)
|
|||
|
Return
|
|||
|
|
|||
|
FillIB: Setzb T2,nIchar ;Gets a line of input from the input
|
|||
|
Move T4,[440700,,InBuf] ;source, with rubout handling, and
|
|||
|
GL2: Move A,iJFN ;stores it in InBuf - Appropriate BPs
|
|||
|
GL2a: BIN ;and character counts are reset.
|
|||
|
Erjmp [Call Unload
|
|||
|
Jrst GLF]
|
|||
|
Andi B,177
|
|||
|
Cain B,^M
|
|||
|
Jrst GL4
|
|||
|
Cain B,^E
|
|||
|
Jrst [Setcmm Echo
|
|||
|
Jrst GL2a]
|
|||
|
Caige B,40
|
|||
|
Jrst GL2
|
|||
|
Cain B,177
|
|||
|
Jrst [Jumpe T2,GL2
|
|||
|
DBP T4
|
|||
|
Movei A,^H
|
|||
|
PBOUT
|
|||
|
Movei A,40
|
|||
|
PBOUT
|
|||
|
Movei A,^H
|
|||
|
PBOUT
|
|||
|
Soja T2,GL2]
|
|||
|
GL3: Move A,B
|
|||
|
Skipe Echo
|
|||
|
PBOUT
|
|||
|
GL4: Cail T2,IBufln*5
|
|||
|
Jrst GL2
|
|||
|
Idpb B,T4
|
|||
|
Aoj T2,
|
|||
|
Caie B,^M
|
|||
|
Jrst GL2
|
|||
|
|
|||
|
GLnulp: Caie T2,1 ;Ignore blank lines.
|
|||
|
Jrst GLF
|
|||
|
Skipe Echo
|
|||
|
Call Terpri
|
|||
|
Jrst FillIB
|
|||
|
|
|||
|
GLF: Idpb T4 ;Store the final 0 to make string ASCIZ
|
|||
|
Move B,[440700,,InBuf]
|
|||
|
Movem B,pInbuf
|
|||
|
Return
|
|||
|
|
|||
|
Getwrd: Setzm IStrin ;Reads one word (terminated by
|
|||
|
Move A,[IStrin,,IStrin+1] ;a blank, tab, or CR), parses
|
|||
|
BLT A,IVal ;it, and sets flags. If INUMp
|
|||
|
Setz T2, ;is true, it's a number, whose
|
|||
|
Move T4,[440700,,IStrin] ;value is in IVAL. If IADDR is
|
|||
|
GWskip: Call Getchr ;nonzero, then it is the address
|
|||
|
Return ;in the Dictionary of the word.
|
|||
|
Caie K,40
|
|||
|
Cain K,^I
|
|||
|
Jrst GWskip
|
|||
|
Jrst GW3
|
|||
|
GW2: Call Getchr
|
|||
|
Jrst Check
|
|||
|
GW3: Caie K,40
|
|||
|
Cain K,^I
|
|||
|
Jrst Check
|
|||
|
Cain K,^M
|
|||
|
Jrst Check
|
|||
|
Cail T3,5*3 ;Only 15 characters are significant
|
|||
|
Jrst GW2
|
|||
|
Cail K,140
|
|||
|
Trz K,40
|
|||
|
Cail K,"0 ;if 0-9, or - in 1st place, or a ".", then ok.
|
|||
|
Caile K,"9
|
|||
|
Skipa
|
|||
|
Jrst GW4
|
|||
|
Cain K,"-
|
|||
|
Skipe T2
|
|||
|
Skipa
|
|||
|
Jrst GW4
|
|||
|
Caie K,".
|
|||
|
Setom NotNum
|
|||
|
GW4: Idpb K,T4 ;Store UPPERCASE
|
|||
|
Aoja T2,GW2
|
|||
|
|
|||
|
Check: Skipn T2
|
|||
|
Return
|
|||
|
Move T1,[350700,,IStrin]
|
|||
|
Call StoN
|
|||
|
Jrst FCheck
|
|||
|
Movem T2,IVal
|
|||
|
Setom INump
|
|||
|
Jrst Popj1
|
|||
|
|
|||
|
FCheck: Skipe NotNum
|
|||
|
Jrst Search
|
|||
|
Move A,[440700,,IStrin]
|
|||
|
FLIN
|
|||
|
Jrst Search
|
|||
|
Movem B,IVal
|
|||
|
Setom INump
|
|||
|
Jrst Popj1
|
|||
|
|
|||
|
Search: Movei T1,Dict
|
|||
|
S1: Move T4,IStrin
|
|||
|
Came T4,(T1)
|
|||
|
Jrst NFound
|
|||
|
Move T4,IStrin+1
|
|||
|
Came T4,1(T1)
|
|||
|
Jrst NFound
|
|||
|
Move T4,IStrin+2
|
|||
|
Came T4,2(T1)
|
|||
|
Jrst NFound
|
|||
|
Hrrzm T1,IAddr
|
|||
|
Jrst Popj1
|
|||
|
|
|||
|
NFound: Hlrz T2,3(T1)
|
|||
|
Skipn T2
|
|||
|
Jrst Popj1
|
|||
|
Add T1,T2
|
|||
|
Jrst S1
|
|||
|
|
|||
|
Eval: Aos Level ;The heart of FORTH. EVAL is the creature that
|
|||
|
Skipn Trace ;evaluates *things* - It either pushes constants,
|
|||
|
Jrst Eval1 ;calls subroutines (FORTH primitives), or EVALs
|
|||
|
Call Terpri ;the body of a FORTH word. Note than that EVAL
|
|||
|
Move C,Level ;is, by nature, recursive.
|
|||
|
Jumpe C,ET1
|
|||
|
IMuli C,2
|
|||
|
Movei A,"=
|
|||
|
PBOUT
|
|||
|
Sojn C,.-1
|
|||
|
ET1: Movei A,">
|
|||
|
PBOUT
|
|||
|
|
|||
|
Eval1: Came L,[-1]
|
|||
|
Jrst Eval2
|
|||
|
Move V,1(E)
|
|||
|
Call 4SAVE
|
|||
|
Skipn Trace
|
|||
|
Aoja E,EExit
|
|||
|
Type " Constant"
|
|||
|
Call SDump
|
|||
|
Aoja E,EExit
|
|||
|
|
|||
|
Eval2: Skipl L
|
|||
|
Jrst Eval3
|
|||
|
Skipe Trace
|
|||
|
Jrst [Movei A,40
|
|||
|
PBOUT
|
|||
|
Call PFind
|
|||
|
Hrli V,350700
|
|||
|
Call 7TLoop
|
|||
|
Jrst .+1]
|
|||
|
Call (L) ; -1,,Subroutine
|
|||
|
Skipe Trace
|
|||
|
Call SDump
|
|||
|
Jrst EExit
|
|||
|
|
|||
|
Eval3: Hrrz T1,L ;T1 = Dict Addr
|
|||
|
Push P,E
|
|||
|
Hrrz E,3(T1) ;Code field
|
|||
|
Movei B,4(T1)
|
|||
|
Movem B,BStart
|
|||
|
Skipn Trace
|
|||
|
Jrst Eval5
|
|||
|
Movei A,40
|
|||
|
PBOUT
|
|||
|
Move V,T1
|
|||
|
Hrli V,350700
|
|||
|
Call 7TLoop
|
|||
|
Call SDump
|
|||
|
|
|||
|
Eval5: Skipe Did
|
|||
|
Jrst EExitd
|
|||
|
Move L,(E)
|
|||
|
Jumpe L,EExit1
|
|||
|
Call Eval ;Recurse!
|
|||
|
Aoja E,Eval5
|
|||
|
|
|||
|
EExitd: Setzm Did
|
|||
|
EExit1: Pop P,E
|
|||
|
EExit: Sos Level
|
|||
|
Return
|
|||
|
|
|||
|
|
|||
|
MHead: Call Getwrd ;This starts a Dictionary entry by filling
|
|||
|
Call Refill ;in the name field, and reserving 1 more.
|
|||
|
Skipe INump
|
|||
|
Jrst [Type " ?Numeric name field"
|
|||
|
Jrst Erret]
|
|||
|
Skipe IAddr
|
|||
|
Jrst [Type " ?Already defined"
|
|||
|
Jrst Erret]
|
|||
|
Movei D,2
|
|||
|
MH2: Move T2,IStrin(D)
|
|||
|
Movem T2,@Dicte
|
|||
|
Sojge D,MH2
|
|||
|
Movei D,3
|
|||
|
Movei A,1
|
|||
|
Movem A,@Dicte
|
|||
|
Return
|
|||
|
|
|||
|
sText: Call Getchr ;This reads text from the input buffer
|
|||
|
Call Refill ;(delimited by 1st character) and stores
|
|||
|
Movem K,Delim ;them using T1 as the BP. It saves the
|
|||
|
sTextd: Hrli T1,440700 ;# of chars read in LSTEXT
|
|||
|
Setzm lsText
|
|||
|
BTLoop: Call Getchr
|
|||
|
Call Refill
|
|||
|
Camn K,Delim
|
|||
|
Jrst BTdone
|
|||
|
Idpb K,T1
|
|||
|
Aos lsText
|
|||
|
Jrst BTLoop
|
|||
|
BTdone: Idpb T1 ;Make asciz
|
|||
|
Return
|
|||
|
|
|||
|
BText: Skipn Making ;Used for ." and so on while building
|
|||
|
Jrst Buierr ;to save the text in the Dictionary entry.
|
|||
|
Move T1,Dicte
|
|||
|
Aoj D,
|
|||
|
Add T1,D
|
|||
|
Call sText
|
|||
|
Move T2,lsText
|
|||
|
Idivi T2,5
|
|||
|
Add D,T2
|
|||
|
Return
|
|||
|
|
|||
|
PFind: Movei V,Dict+3 ;This finds the address of the primitive
|
|||
|
PFind1: Hrre A,(V) ;whose machine address we know (L)
|
|||
|
Jumpg A,[Setz V,
|
|||
|
Return]
|
|||
|
Came L,1(V)
|
|||
|
Jrst [Hlrz B,(V)
|
|||
|
Add V,B
|
|||
|
Jrst PFind1]
|
|||
|
Subi V,3
|
|||
|
Return
|
|||
|
|
|||
|
SDump: Call Terpri ;This dumps the top 10. numbers
|
|||
|
Type "[ " ;on the stack for TRACEing. TOS
|
|||
|
Jumpe U,[Type "Nil ] " ;is to the right.
|
|||
|
Return]
|
|||
|
Move C,U
|
|||
|
Soj C,
|
|||
|
Caig C,10.
|
|||
|
Jrst SDump1
|
|||
|
Type "... "
|
|||
|
Movei C,10.
|
|||
|
SDump1: Move V,S
|
|||
|
Sub V,C
|
|||
|
Move V,(V)
|
|||
|
Call Dota
|
|||
|
Sojge C,SDump1
|
|||
|
Type "] "
|
|||
|
Return
|
|||
|
|
|||
|
StoN: Setzb A,B ;This is the String-to-Number routine. It
|
|||
|
Setzb T3,StoNmp ;expects a BP to the text in T1, and returns
|
|||
|
SN1: Ldb K,T1 ;(skipping) with T2 as the number, and T3
|
|||
|
Caie K,40 ;the number of character read.
|
|||
|
Cain K,^I
|
|||
|
Aoja T3,SN1
|
|||
|
Skipa
|
|||
|
SN2: Ldb K,T1
|
|||
|
Aoj A,
|
|||
|
Caie K,40 ;String ends on "," or <space> or <cr>
|
|||
|
Cain K,^M ;or a 0-byte
|
|||
|
Jrst SNtest
|
|||
|
Caie K,",
|
|||
|
Skipn K
|
|||
|
Jrst SNtest
|
|||
|
Cain K,"-
|
|||
|
Caie A,1
|
|||
|
Jrst SN3
|
|||
|
Setom StoNmp
|
|||
|
Ibp T1
|
|||
|
Jrst SN2
|
|||
|
SN3: Subi K,60
|
|||
|
Skipge K
|
|||
|
Jrst SNbad
|
|||
|
Caml K,Base
|
|||
|
Jrst SNbad
|
|||
|
Push P,K
|
|||
|
Ibp T1
|
|||
|
Aoja B,SN2
|
|||
|
|
|||
|
SNtest: Jumpe B,SNbad
|
|||
|
Setz T2,
|
|||
|
Movei T4,1
|
|||
|
SNgood: Pop P,K
|
|||
|
Imul K,T4
|
|||
|
Imul T4,Base
|
|||
|
Add T2,K
|
|||
|
Sojn B,SNgood
|
|||
|
SNg2: Skipe StoNmp
|
|||
|
Movns T2
|
|||
|
Add T3,A
|
|||
|
Jrst Popj1
|
|||
|
|
|||
|
SNbad: Skipn B
|
|||
|
Return
|
|||
|
Pop P,K
|
|||
|
Soja B,SNbad
|
|||
|
|
|||
|
Lose: Type "--Severe lossage--Dying--"
|
|||
|
Die: HALTF
|
|||
|
Jrst .-1
|
|||
|
|
|||
|
;;;
|
|||
|
;;; The End
|
|||
|
;;;
|
|||
|
|
|||
|
Variables
|
|||
|
Constants
|
|||
|
|
|||
|
END Start |