PAGE 65000,255
;METAL 004 Give up on the BP insync with SP thing for now - put it back in later if necessary. 
;          Can tokenize simple "|'Hello'?'Hi'.|'Bye'?'Later'.. " command line into outbuf but does not execute it.
;METAL 005 Start adding buffers

	.MODEL SMALL

	.STACK 100h

	.CODE
	ORG 100h

	ASSUME es:@code
	ASSUME ds:@code
         
Read	EQU  1

StartOfText	EQU  "'"
EndOfText	EQU  "'"

Do	MACRO Call TStart #EM	;Token list following this begins executing.

Next    MACRO RET #1 #EM		;Current machine code stops.
					;Parent code resumes executing.

Token	MACRO
T#1	EQU $ - TTable
	DW #1
	#EM
	
cp2oset	MACRO		;Preferably chunk pointer in cl and returns result in ax or any other 16 bit reg or var

	##IF '#1' EQ 'AH'
	XCHG AL,AH
	##ENDIF

	##IF '#1' EQ 'AH' OR '#1' EQ 'AL'
	 ##IF '#2' EQ 'AX' ;AH (now in AL) or AL to AX: Preserve all of CX and destination not available so must use stack
	  PUSH CX
	  MOV CL,AL
	 ##ELSE 
	  ##IF '#2' NE 'CX' ;AH (now in AL) or AL to anything but AX or CX: use eventual destination to save CX
	   XCHG CX,#2
	   ##ENDIF
	  ;AH (now in AL) or AL to anything but AX: Get #1 into CL and use CH to save AH or AL (now in AH)
	  MOV CX,AX 
	  ##ENDIF
	##ELSE ;not AH or AL
	 ##IF '#2' EQ 'CX'
	  PUSH AX ;not AH or AL to CX: Preserve all of AX and destination not available so must use stack
	 ##ELSE
	  ##IF '#2' NE 'AX';not AH or AL and not AX or CX
	   XCHG AX, #2
	   ##ENDIF
	  ##ENDIF
	 ##IF '#1' NE 'CL' ;not AH, AL or CL
	  XCHG CL,#1
	  ##ENDIF
	 MOV AL,CL
	 ##ENDIF

	XOR AH,AH
	AND CL,03
	SHL AX,CL
	SHL AX,CL
	ADD AL,CL
	ADC AX,0
	INC AX
	
	##IF '#2' EQ 'AX'
	 ##IF '#1' EQ 'AL' OR '#1' EQ 'AH'
	  POP CX
	 ##ELSE ; not AL or AH
	  ##IF '#1' NE 'CL'
	   XCHG #1,CL
	   ##ENDIF
	  ##ENDIF
	##ELSE ; not AX
	 XCHG AX,#2
	 ##IF '#2' EQ 'CX'
	  ##IF '#1' EQ 'AL' OR '#1' EQ 'AH'
	  ##ELSE
	   POP AX
	   ##ENDIF
	 ##ELSE ; not AX or CX
	  ##IF '#1' EQ 'AL' OR '#1' EQ 'AH'
	   XCHG AX,CX
	  ##ELSE ; not AX or CX and not AL or AH
	   ##IF '#1' NE 'CL'
	    XCHG #1,CL
	    ##ENDIF
	   ##ENDIF
	  ##ENDIF
	 ; not AX
	 ##IF '#1' EQ 'AH'
	  XCHG AL,AH
	  ##ENDIF
	 ##ENDIF
	  

	#EM	

; Start
;--------------------------------------------------------------------


	MOV AX,CS			;All segments are the same!
	MOV ES,AX
	MOV DS,AX

	MOV SI,0083		;will be 0080(?) when using Buffer methods
	MOV DI,offset OutBufPtr
	MOV CX,0FF
    L1:	
    	MOV DL,CL
 	cp2oset DL,AX
	loop L1
	
	Call MetaL
	RET



Message	DB 0

MatchInOutW	EQU [$]
MatchInOut	DB 0,0		;Variable that indicates that match should 0) look for 
				; matches in the InBuffer or 1) put data into the OutBuffer



; The threader is the heart of the language
;--------------------------------------------------------------------


TDrop:	POP BX
	RET
TStart:
TNext:	
	JNC >L1			;Stop if Carry flag set
	POP AX			;Clear the token pointer
	CLC			; and the carry flag
	RET			;
    L1:	POP BX			;Retrieve from the stack, a pointer to the tokens currently being executed
	INC BX			;Increment the pointer
	PUSH BX			;Put it back on the stack for use next time
	PUSH Offset TNext	; by TNext
	MOV BL,[BX-1]		;Get the Token originally pointed to
	XOR BH,BH
	JMP [BX+TTable]		;Jump to its address in the Token Table



;Fail To--------------------------------------------------------------------
FailTo:
RunFailTo:		;Insert a FailTo pointer in the stack. Assumes call from our Threader; TNext
	MOV BP,SP
	MOV BX,[BP+2]	;Get the byte code pointer
	MOV AL,[BX]	;Get the byte offset at the code pointer
	CBW		; as a word offset (FF or -1 is now FFFF and still -1)
	ADD AX,BX	;Calculate the FailTo Pointer = IP + Offset
	POP CX		;I had better have been called by TNext but just incase...
	POP DX		;Get Parent code pointer
	INC DX		;Skip data pointer past the offset byte
	PUSH AX		;[TOS+8] FailTo Pointer
	PUSH MatchInOutW;[TOS+6] Previous success state
	PUSH offset ReturnFailTo
			;[TOS+4] Copy of the parent code interpreter
	PUSH DX		;[TOS+2] My parent code pointer
	PUSH CX		;[TOS-0] My parent code interpreter
	CLC
	NEXT		;Do the next token

ReturnFailTo:
	CMP B MatchInOut,1	;If we succeeded then set the carry flag so dad will also quit and
	CMC			; clear it if we didn't so that dad will keep trying
	POP MatchInOutW		;Restore it in any case so that
	JMP TNext		; quiting will quit with grandpa or which ever ancestor is appropriate.	

;Link-----------------------------------------------------------------------------------
Link:
	MOV  BX,OFFSET ReturnLink
	POP  CX		;Save my parent code interpreter
	POP  AX		;Save my parent code pointer
	PUSH DI		;[TOS+6] Pointer to byte after the TEntry I just 
			; outbuffed where LinkFailTo will place the offset
			; to the code following the next TStop
	ADD  DI,1	;And make room for that byte
	PUSH BX		;[TOS+4] Pointer to LinkFailTo
	PUSH AX		;[TOS+2] My parent code pointer
	PUSH CX		;[TOS+0] My parent code Interpreter
	MOV Message,0
	NEXT

ReturnLink:
	POP  BX		;Get the Pointer to the byte to link
	MOV  AX,BX	;Get the address of the FailTo token
	SUB  AX,DI	;Calculate the offset between the FailTo token and 
			; the byte after the matching Stop token.
	NEG AX
	MOV  [BX],AL	;Update the FailTo offset byte.
	NEXT

         
ReadFailTo:
;         Con: LeftMargin Indent to CurPos
;              Disp '|'
;              .
         db ' '

;MATCH --------------------------------------------------------------------
Match:
	CMP MatchInOut, 0
	JNZ BufOut
	MOV BP,SP
	PUSH DI			;Save the outbuf pointer
	MOV  DI,[BP+2]		;point to the parent code data buffer (count+string) to match
	XOR CX,CX		;clear a counter
	MOV CL,[DI]		;load the byte count to match
;need to process zero length and chunk (255) flags in the future
	INC DI			;point to the string after the byte count
	CALL MethodMatch	;try for a match
	MOV  [BP+2],DI		;in any case, upate the parent code IP
	POP DI			; and restore the outbuf pointer
	NEXT			; just continue, TNext will stop if Carry set.

MethodMatch:
;Compare the string at SI with the string at DI for a count of CX.
;Always exit with:
; DI past the end of the code string (program code) and 
; SI at the start of the buffer string if no match and at end if match (Inbuffer)
; Carry Flag set if no match and clear if match.
	PUSH SI			;save the buffer string pointer
	CLD			;look forward
	REPZ CMPSB		;compare the source and destination
	JZ   >L1
	ADD DI,CX		;It doesn't match; point past the code string,
	POP SI			; restore the buffer string to the start for the next try
	STC			; set the carry flag, and
	RET			; return
         
    L1:	POP AX			;It matched, dump the saved buffer string pointer so 
				; the buffer pointer is past the matched string, 
	CLC			; clear the carry flag, and
	RET			; return

         
ReadMatch:
;        BEGIN
;        DW SelfInhertParms
;        DW OutUnderline
;        DW OutString
;        DW OutEndUnderline
;        DW End
	db StartOfText            

;BufOut (match after then)-----------------------------------------------------------------
; set the source to the code pointed to by the IP ([SP+2])
; Load a length byte from the code
; If the byte is zero, 
;       get the ending token byte following the length byte
;       set the source back to the inbuffer
;       look for the ending token byte in the source and
;       if found
;            set the length to the number bytes untill the ending token byte
;            reset the source to the beginning of the inbuffer
;            transfer length bytes from the source to the outbuffer
;            update the inbuffer pointer to point past the ending token byte
;         else
;            Reset the InBuffer and OutBuffer
;            return with carry set
;            .
;    else
; transfer length bytes from the source to the outbuffer
; restore the source to the inbuffer
;

BufOut:
	MOV BP,SP
	PUSH SI		;Save the InBufPtr
	MOV SI,[BP+2]	;Get the byte code pointer
	LODSB		;Get the byte Count at the code pointer
	AND AX,0F	;Clear AH and set the flags
	MOV CX,AX	;Move it to the counter
	JZ >L1		;If the count is not zero
	REP MOVSB	;Move Count Bytes from the source (either the code or the InBuffer) to the OutBuffer
	MOV [BP+2],SI	;Update the source
	POP SI		;Restore the InBufPtr
	JMP >L2		;exit
    L1:	
	DEC CL		;Set the count to 255
	LODSB		;Get the ending token
	PUSH DI		;Save the OutBufPtr
	MOV DI,[BP-2]	;Set the OutBufPtr to InBufPtr
	REP SCASB	;Look for a match
	POP DI		;Restore the OutBufPtr
	NEG CL		
	SUB CL,1	;CL now hold the count of the number of bytes till match and Carry is set if zero
	POP SI		;reset the source to the beginning of the InBuffer
	JC >L2	
	MOV AX,CX	
	STOSB		;Save the count byte to the outbuffer
	REP MOVSB	;Move Count Bytes from the source (either the code or the InBuffer) to the OutBuffer
	INC SI		;Skip past the ending token
    L2:	
	NEXT
	
;Define----------------------------------------------------------------------
Define:	RET

;Then---------------------------------------------------------------------
Then:
	MOV AX,BX
	MOV BL,Message
	SHL BX,1
	JMP [BX+$+4]
	DW RunThen
	DW ReadMatch

RunThen:
	INC MatchInOut
	Next


ReturnThen:
	RET

ReadThen:
	DB '?'

;Stop--------------------------------------------------------------------
Stop:
	MOV AX,BX
	MOV BL,Message
	SHL BX,1
	JMP [BX+$+4]
	DW RunStop
	DW ReadStop

         
RunStop:
	STC		;Set the Carry Flag
	NEXT

ReadStop:
;         Con: LeftMargin Outdent to Prev
;              CrLf
;              Disp '.'
;              .

         DB 0

;File ------------------------
File:	RET

;FBuf -----------------------
FBuf:	RET

InBuf		DB 	TStdIO	;token of the buffer currently used for input
InBufPtr	DW	0080		;Pointer to the currently used InBuf structure
OutBuf	DB HIGH(OutBufCache)		;Pointer to the currently used OutBuf structure

TTable:					;table of addresses to methods
Token MetaL
Token MWord
Token FailTo
Token Match
Token Then
Token Stop
Token BufOut
Token Link
Token Define
Token File
Token FBuf
Token StdIO

	EVEN 256
FUrl		DB 256 DUP 0
	EVEN 256
FOffset		DB 256 DUP 0
	EVEN 256
FCache		DB 256 DUP 0

	EVEN 256
OutBufCache	DB 254 ;length byte
MetaL:	Do
	DB TFailTo, -1, TMWord, TMatch, 1, '.', TThen, TStop			; [ MWord '.' ? . ]
	DB TStop								; .

MWord:	Do
	DB TFailTo, +9, TMatch, 1, '|', TThen, TBufOut, 1, TFailTo, TLink, TMetaL, TStop
	DB TFailTo, +8, TMatch, 1, StartOfText, TThen, TBufOut, 1, TMatch, TBufOut, 0, EndOfText, TStop.
	DB TFailTo, +8, TMatch, 1, '?', TThen, TBufOut, 1, TThen, TStop
	DB TFailTo, +8, TMatch, 1, '@', 
	DB	TFailTo, + , Tmatch, 4, 'file', TDefine, TFile, TThen, TStop
;					Name	Method	Len	handle	url		offset		cache
	DB	TFailTo, + , Tmatch, 4, 'StdIO', TDefine, 
StdIO:	DB					TFBuf,	0,	1,	HIGH(FUrl),	HIGH(FOffset),	HIGH(FCache)
	DB TStop
; .
	

OutBufPtr:
Continue: