PAGE 65000,255 .MODEL SMALL .STACK 100h .CODE ORG 100h ASSUME es:@code ASSUME ds:@code Read EQU 1 StartOfText EQU "'" EndOfText EQU "'" DoToPrev MACRO Call TNext #EM ;Token list following this begins executing. ;Parameters will be taken from same location ; as they were in previous code. DoToOwn MACRO Call TDataTOS #EM ;Token list following this begins executing. ;Parameters will be taken from inside this ; Token list (immediate operands). Next MACRO RET #1 #EM ;Current machine code stops. ;Parent code resumes executing. Token MACRO T#1 EQU $ - TTable DW #1 #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 OutBuf Call MetaL RET MetaL: DoToOwn ;need a looping construct to take more than one match DB TFailTo, -1, TMWord, TMatch, 1, '.', TThen, TStop ; [ MWord '.' ? . ] DB TStop ; . MWord: DoToOwn DB TFailTo, +9, TMatch, 1, '|', TWeave, TFailTo, TMetaL, TThen, TStop ; | "|" : FailTo MetaL ? . DB TFailTo, +8, TMatch, 1, StartOfText, TThen, TWeave, TMatch, TStop ; | """ ? : Match . DB TFailTo, +8, TMatch, 1, '?', TThen, TWeave, TThen, TStop ; | "?" ? : Then . DB TThen, TMatch, 5, 'ERROR', TStop ; ? 'Error' . DB TStop ; . 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 TTable: ;table of addresses to methods Token MetaL Token MWord Token FailTo Token Match Token Then Token Weave Token Stop ; The threader is the heart of the language ;-------------------------------------------------------------------- TDrop: CMP BP,SP JNZ >L1 SUB BP,4 L1: POP BX TDataTOS: POP AX PUSH MatchInOutW PUSH ReturnThen MOV MatchInOut,0 PUSH AX MOV BP,SP SUB BP,2 TNext: JNC >L1 ;Stop if Carry flag set MOV AX,SP SUB AX,BP CMP AX,2 JNZ >L2 ADD BP,4 L2: 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: XOR BX,BX MOV BL,Message SHL BX,1 JMP [BX+$+4] DW RunFailTo DW WeaveFailTo DW ReadFailTo WeaveFailTo: CMP BP,SP JNZ >L1 SUB BP,4 L1: MOV Al, TFailTo STOSB ;Outbuf a Token for myself MOV BX,OFFSET LinkFailTo 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 LinkFailTo: CMP BP,SP JNE >L1 ;if BP,SP insync ADD BP,4 ; keep it that way L1: 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],AX ;Update the FailTo offset byte. NEXT RunFailTo: ;Insert a FailTo pointer in the stack. Assumes call from our Threader; TNext CMP BP,SP JNZ >L1 SUB BP,4 L1: MOV BX,[BP+6] MOV AL,[BX] ;Get the byte offset 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 incase not DataTOS PUSH AX ;[TOS+6] FailTo Pointer PUSH offset ReturnFailTo ;[TOS+4] Copy of the parent code interpreter PUSH DX ;[TOS+2] My parent code pointer will be [BP+2] if DataTOS INC W[BP+2] ;Skip data pointer past the offset byte 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 MOV MatchInOut,0 ;but reduce it in any case so that JMP TNext ; quiting will quit with grandpa or which ever ancestor is appropriate. ReadFailTo: ; Con: LeftMargin Indent to CurPos ; Disp '|' ; . db ' ' ;MATCH -------------------------------------------------------------------- Match: XOR BX,BX MOV BL,Message SHL BX,1 JMP [BX+$+4] DW RunMatch DW WeaveMatch DW ReadMatch WeaveMatch: ; matching a StartOfText character got us here so put the Match token, a byte ; count of the text, and the actual text between the StartOfText and EndOfText ; into the OutBuffer. MOV AL, TMatch STOSB ;OutBuf my token MOV BX, DI ;Save a pointer to the match count byte INC DI ;and make space for it. XOR CX,CX ;Clear a counter JMP >L1 MMatch1: INC CX ;We have a byte to outbuf, so count it and STOSB ;Outbuf the byte L1: LODSB ;Get a byte from InBuf CMP AL,EndOfText ;Is this the End of Text marker? JNE MMatch1 ;Loop until MOV [BX],CL ;Update the count byte with the counter MOV Message, 0 ;Done with the Weave NEXT RunMatch: 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 ;Then--------------------------------------------------------------------- Then: INC MatchInOut Next ReturnThen: CMP BP,SP JNZ >L1 ADD BP,2 L1: POP MatchInOutW RET ;Weave-------------------------------------------------------------------- Weave: MOV Message, 1 NEXT ;Stop-------------------------------------------------------------------- Stop: XOR BX,BX MOV BL,Message SHL BX,1 JMP [BX+$+4] DW RunStop DW WeaveStop DW ReadStop WeaveStop: MOV AL,TStop STOSW ; Link my matching FailTo or other flow codes. NEXT RunStop: STC ;Set the Carry Flag NEXT ReadStop: ; Con: LeftMargin Outdent to Prev ; CrLf ; Disp '.' ; . DB 0 WeaveDefine: ;-------------------------------------------------------------------- CMP BYTE PTR [SI],":" JNE WeaveROL INC SI MOV AX,OFFSET RunDefine STOSW MOV AL,0E8h ; Call STOSB MOV AX,OFFSET TNext STOSW NEXT Define: RunDefine: POP AX STOSW NEXT ReadDefine: ; Con: Disp ':' ; . WeaveROL: ;-------------------------------------------------------------------- CMP BYTE PTR [SI],11h JNE WeaveSTC INC SI MOV AX,OFFSET RunROL STOSW NEXT RunROL: ROL BYTE PTR [DI],1 NEXT WeaveSTC: CMP BYTE PTR [SI],17h JNE WeaveCLC INC SI MOV AX,OFFSET RunSTC STOSW NEXT RunSTC: STC ROL BYTE PTR [DI],1 NEXT WeaveCLC: CMP BYTE PTR [SI],12h JNE Continue INC SI MOV AX,OFFSET RunCLC STOSW NEXT RunCLC: CLC ROL BYTE PTR [DI],1 NEXT DB 0Eh DUP(11h) Continue: OutBuf DB 100 DUP(0)