|
nedoPC.orgElectronics hobbyists community established in 2002 |
|
Author |
Message |
shoorick
Doomed
Joined: 05 Nov 2007 05:08 Posts: 487 Location: Украина
|
месье! вы напрягаете мой склероз! RFORTH изначально содержит кириллические имена слов. Под русификацией я имел ввиду встроенный прямо в форт-систему кириллический шрифт и обработчик кодов клавиш, т.к. одно время мечтал записать его в расширение БИУСа
|
17 May 2020 13:35 |
|
|
Lavr
Supreme God
Joined: 21 Oct 2009 08:08 Posts: 7777 Location: Россия
|
Щаз ещё напрягу! Ты ж "старый фортер"! Кого ж еще спрашивать? По ходу моей "пьесы" надо было адаптировать вот такой момент: Но в Форте от Шихова слова Leave не было... И как я ни старался, реализовать Leave средствами Форта не смог... Ты не знаешь, как это сделать? Именно средствами Форта, не трогая его код. P.S. Ну и поскольку как устроен Форт внутри я немного проникся, а к Форту меня всегда приводит мысль "нужен маленький ЯВУ для поделки с ограниченными ресурсами", стало мне зело интересно, а как реализовывали Форт на бесстековых машинах, к примеру, на PDP-8... И как ни странно, Форт для PDP-8 от какого-то умельца-фортера я вроде как нашел! Код на github я посмотрел, но, честно, не понял в нём нифига...
_________________ iLavr
|
17 May 2020 13:43 |
|
|
shoorick
Doomed
Joined: 05 Nov 2007 05:08 Posts: 487 Location: Украина
|
К форту я потерял интерес после того, как начал пытаться делать на нем что-то практическое. Падучесть очень высокая, выше чем у асма (если что - мое личное впечатление). Надо быть очень внимательным. Насчет выходов из цикла - не помню. Реализовать такое непросто. После выполнения слова DO в стеке хранится адрес возврата, который извлекает слово LOOP, чтобы записать в себя куда LOOP в начало цикла, a с технической точки зрения LEAVE сродни слову IF: IF помещает в стек адрес своего перехода, который ENDIF извлекает и записывает туда свой адрес - в результате, если условие не выполняется, происходит переход сразу в район ENDIF. Т.е. нужно так переделать LOOP, чтобы оно позаписывало адрес на себя во все слова LEAVE внутри цикла - т.е. это возможно, но сложно, проще внутри цикла поставить условие. При этом следует иметь в виду, что все выравнивания стека внутри циклов и условий лежат на программисте - это вам не винапи, где винда перед возвратом еще и маркер свой в стеке проверяет - си-вызов был или паскаль? (не всегда, правда). Кстати слово типа REPEAT (переход сразу на начало цикла из его середины) сделать проще - это то же LOOP, только не удаляющее адрес начала цикола из стека (типо как ELSE - ELSE заменяет адрес IF в стеке на свой для ENDIF, а в IF записывает переход на себя). Плюс (практически) невозможно размещать LEAVE внутри условий IF-ENDIF (и REPEAT, кстати, тоже), так как это нарушит их (условий IF-ENDIF) компиляцию. Хотя можно использовать вариант условного выхода или перехода в начало, типа, LEAVEIF или REPEATIF. Форт штука гениальная, но компилятор близорукий.
|
17 May 2020 21:19 |
|
|
Lavr
Supreme God
Joined: 21 Oct 2009 08:08 Posts: 7777 Location: Россия
|
Тут, честно говоря, соглашусь - падучесть очень высокая, и это потому, я считаю, что АСМ делает только то, что ты написал. А FORTH еще сам что-то делает, и не всегда угадаешь, правильно ли он тебя понял, и что он сделает. И - да, за стеками надо четко следить. Насчет слова LEAVE пишут вот что: Собственно говоря, это и понятно, в другом языке я бы вышел из цикла со счетчиком, задав ему значение априори выше максимального. Но в цикле DO…LOOP переменная цикла I (или J) доступны только на чтение. С другой стороны Н.Шихов написал, что его словаря достаточно, чтобы сделать на этом Форте любые другие слова Форта, поэтому хотелось сделать LEAVE средствами самогО Форта... Хотя... я сейчас читаю исходник внимательно: оригинальных процедур в Форте немного, остальные используют активно эти процедуры Форта плюс немного ассемблера. P.S. И я тут разыскал исходник Форта для PDP-8 исторических времён, не новодел: FORTH COMPILER/INTERPRETER FOR TSS/8.24 | | | | Code: / ** FORTH-8 ** /FORTH COMPILER/INTERPRETER /FOR TSS/8.24 PAL/D assembler /STARTED 29-JUL-84 /BY JOHN WILSON. / *0 JMP START /BETCHA DIDN'T KNOW YOU COULD JUMP-START A PROGRAM! / FIXTAB BSW= 7002 / JUMP= JMS I . JUMP0 /JUMP TO ADDRESS FOLLOWING JMS CALL= JMS I . CALL0 /CALL TO ADDR FOLLOWING JMS, USING STACK RET= JMP I . RET0 /POP VALUE OFF STACK, JUMP TO IT RPUSH= JMS I . RPUSH0 /PUSH AC TO RETURN STACK RPOP= JMS I . RPOP0 /POP RETURN STACK TO AC PPUSH= JMS I . PPUSH0 /PUSH AC TO PARAMETER STACK PPOP= JMS I . PPOP0 /POP PARAMETER STACK TO AC *10 INDEX1, 0 /SCRATCH AUTO-INDEXING POINTER INDEX2, 0 INDEX3, 0 /CONSTANTS: C0007, 7 C0027, 27 C0077, 77 C0240, 240 C7540, 7540 *20 DP, USRDCT /DICTIONARY PTR IMMDP, ICODE /DICT PTR INTO IMMEDIATE BUFFER / SP, 0 /RETURN STACK POINTER PSP, 0 /PARAMETER STACK POINTER NSP, 0 /NESTING STACK POINTER / /TEMPORARY VARIABLES: TEMP1, 0 TEMP2, 0 TEMP3, 0 TEMP4, 0 TEMP5, 0 / ERROR= JMS I . ERROR0 /PRINT TRIMMED ASCII ERROR MESSAGE AFTER JMS, & ABORT PPUSHC= JMS I . PPC0 /PUSH CONSTANT AFTER JMS TO PARAMETER STACK NPUSH= JMS I . NPUSH0 /PUSH AC AND WORD AFTER JMS TO NESTING STACK NPOP= JMS I . NPOP0 /CHECK FOR MATCH WITH WORD AFTER JMS, POP AC FROM NSTACK DCTVAL= JMS I . DCTVA0 /PUT AC IN DICT (ONLY), AND ADVANCE DP DCTCON= JMS I . DCTCO0 /PUT WORD FOLLOWING JMS IN DICT, ADVANCE DP PUTVAL= JMS I . PUTVA0 /PUT AC IN CURRENT BUFFER, AND ADVANCE PTR PUTCON= JMS I . PUTCO0 /PUT WORD FOLLOWING JMS IN CURR BUFF, & ADVANCE PTR TYPE= JMS I . TYPE0 /TYPE .ASCIZ STRING FOLLOWING JMS PRINT= JMS I . PRINT0 /PRINT CHAR IN AC, UPDATE PRCOL CRLF= JMS I . CRLF0 /PRINT CR, LF RTS= JMP I . DOWORD /DO NEXT WORD (RETURN FROM TSTRU'S) RUNIMM= JMS I . RUNIM0 /RUN IMMEDIATE CODE, IF ANY CURRDP= JMS I . CURRD0 /RETURN DP FOR CURRENT BUFFER (SELON INWORD) IF= JMS I . WHILE= JMS I . UNTIL= JMS I . JUMPZ /PPOP, JUMP TO @PC IF ZERO DO= JMS I . DO0 /COPY TOP TWO ARGS ON PSTACK TO RSTACK LOOP= JMS I . LOOP0 /INC @RSP, LOOP IF NOT EQUAL TO @RSP+1, ELSE CLEAR RSTACK / /NESTING STACK TOKENS: TIF= 1 /IF-ELSE-THEN TBEGIN= 2 /BEGIN-UNTIL, BEGIN-WHILE-REPEAT, BEGIN-AGAIN TWHILE= 3 /BEGIN-WHILE-REPEAT TDO= 4 /DO-LOOP, DO-+LOOP, DO-/LOOP / PRCOL, 0 /CURRENT PRINTING COLUMN (FOR TABS) KBFILE, 0 /<>0 -> REDIRECTING KB INPUT FROM CHANNEL 0 (LOAD) INWORD, 0 /<>0 -> COMPILING A WORD (: ... ;) NLEVEL, 0 /CURRENT NESTING LEVEL CARETF, 0 /<>0 -> PRINT "^" UNDER LAST WORD READ ON ERROR ERRCOL, 0 /ADDR OF BEGN OF LAST WORD READ FROM LINE (FOR "^" ON ERR) PROMPT, 0 /<>0 -> PROMPT WITH "OK" (ONLY IF THINGS ARE OKAY!) DELFLG, 0 /<>0 -> BETWEEN \'S (ON INPUT) LINPTR, LINE /PTR TO NEXT WORD IN LINE / M0211, -211 WORDM1, WORD-1 CLINE, LINE CWORD, WORD LOOKUP, LOOKU0 /PTR TO LOOKUP ROUTINE MAKEW, MAKEW0 /PTR TO ROUTINE TO BUILD A WORD HEADER GETWRD, GETW /PTR TO ROUTINE TO READ A WORD FROM THE KB SMUDGE, 0 /PTR TO LINK TO LAST CREATED WORD (ZEROED ON ERR) / /INITIALIZE POINTERS, SET ^C VECTOR CTRLC /^C VECTOR START, CLA+400 /=7600 (RSTACK/PSTACK BOUNDARY) TAD .-2 /GET ^C VECTOR SRA /SET IT UND /TURN OFF ECHO STA /SET KB BREAK KSB /TO ANYTHING TYPE /PRINT "FORTH-8 BY JOHN WILSON" "F;"O+40;"R+40;"T+40;"H+40;"-;"8;240;240 /KINKY LOWER CASE "B+40;"Y+40;240;"J;"O+40;"H+40;"N+40;240 "W;"I+40;"L+40;"S+40;"O+40;"N+40 215;212;0 /CR,LF,<NUL> / RESET, TAD START /LOAD 7600 DCA PSP /SET PSTACK PTR CTRLC, CLA /JUMP HERE ON ^C DCA I LINPTR /FORCE KB READ ON NEXT GETW TAD ICODE0 /GET PTR TO IMM CODE DCA IMMDP /POKE IT TO PTR DCA NSP /SET NSTACK PTR DCA SP /SET RSTACK PTR IAC /SET BIT FOR CHAN 0 (KB REDIRECTION) ISZ KBFILE /REDIRECTING INPUT? SKP CLA /NO, DON'T WASTE FIP'S TIME CLOS /YES, CLOSE THE FILE DCA KBFILE /ANYWAY, WE'RE NOT NOW TAD SMUDGE /KILL LAST WORD? SNA CLA JMP .+5 /NO, CONTINUE TAD I SMUDGE /YES, GET LINK TO CONDEMNED WORD DCA DP /BACK UP DP DCA I SMUDGE /CLEAR OUT THE LINK DCA SMUDGE /DON'T DO THIS AGAIN DCA NLEVEL /CLEAR NESTING LEVEL CMA /PRINT "^" UNDER ERRORS DCA CARETF DCA INWORD /NOT IN A WORD (: DEF'N) /THAT SHOULD DO IT - NOW START THE INTERPRETER JMP I .+1 C0200, DOWORD /JUMP INTO LOOP ICODE0, ICODE /BEGN OF IMMEDIATE CODE / PAGE / DOWORD, /GET AND COMPILE A WORD JMS GETW /GET A WORD JMS I LOOKUP /LOOK UP THE WORD SZL /SKIP IF FOUND JMP DOWOR1 /NOT FOUND, MAYBE IT'S A # TAD I TEMP1 /GET TYPE DCA TEMP2 /SAVE ISZ TEMP1 /INC PTR JMP I TEMP2 /TYPE IS ALSO VECTOR TCONS, /CONSTANT TAD I TEMP1 /GET VALUE DCA TEMP1 /SAVE AS ADDR (FAKE OUT TVARI) TVARI, /VARIABLE PUTCON /COMPILE A PPUSHC PPUSHC /THAT'S WHAT I SAID TAD TEMP1 /GET ADDR (VALUE IF TCONS) PUTVAL /COMPILE IT IN-LINE JMP DOWORD /LOOP TSUBR, /SUBROUTINE (: ... ;) PUTCON /COMPILE A CALL CALL /YEP TAD TEMP1 /GET ADDR PUTVAL /LOOKS AN AWFUL LOT LIKE TVARI! JMP DOWORD /LOOP TSTRU, /CONTROL STRUCTURE (DO-LOOP, IF-ELSE-THEN, ETC.) JMP I TEMP1 /JUMP TO COMPILATION ROUTINE /CONTROL STRUC ROUTINES RETURN VIA "RTS" (JMP I (DOWORD)) DOWOR1, /WORD NOT DEFINED, CHECK FOR NUMBER TAD CWORD /POINT AT WORD DCA TEMP1 /SAVE PTR JMS NUM /SEE IF NUMBER SNL /NO, ERROR JMP DOWOR2 /YES, VALUE IS IN TEMP2, GO PPUSHC IT ERROR /UNDEFINED WORD TEXT /WHAT?/ /I JUST LOVE VAGUE MESSAGES! DOWOR2, PUTCON /PPUSHC PPUSHC /... TAD TEMP2 /GET VAL BACK PUTVAL /COMPILE IN-LINE JMP DOWORD /DO ANOTHER WORD / NUM, 0 /CONVERT .ASCIZ NUMBER AT @TEMP1 TO BINARY /RESULT IN TEMP2, LINK SET IF NOT VALID NUMBER. DCA TEMP2 /CLEAR ACCUMULATOR DCA TEMP3 /CLEAR NEGATIVE FLAG TAD I TEMP1 /GET FIRST CHAR TAD MMINUS /"-" ? SZA CLA /SKIP IF SO JMP NUM1 /NO ISZ TEMP3 /SET FLAG ISZ TEMP1 /INC PTR NUM1, TAD I TEMP1 /GET A CHAR SNA /SKIP IF NOT DONE JMP NUM2 /DONE, WHEE! TAD NUM4 /MOVE TO RANGE [-10,-1] CLL TAD C0012 /FLIP LINK IF VALID DECIMAL SNL /SKIP IF HOOPY JMP NUM3 /INVALID DIGIT - NOT A NUMBER DCA TEMP4 /SAVE TAD TEMP2 /GET OLD NUMBER CLL RTL /*4 TAD TEMP2 /+NUMBER CLL RAL /*2 =(((N*4)+N)*2)=N*10. TAD TEMP4 /ADD IN NEW DIGIT DCA TEMP2 /REPLACE ISZ TEMP1 /INC PTR JMP NUM1 /LOOP NUM2, TAD TEMP3 /NEGATE? SNA CLA JMP .+4 /NO, SKIP TAD TEMP2 /GET NUMBER CIA /NEGATE DCA TEMP2 /REPLACE CLL /CLEAR LINK - VALID NUMBER JMP I NUM /RETURN WITH VALUE IN TEMP2 NUM3, STL /NOT A NUMBER JMP I NUM /RETURN NUM4, -12-"0 C0012, 12 MMINUS, -"- / GETW, 0 /READ A WORD FROM @LINPTR TO FIRST CTRL CHAR OR SPACE /ENTER WITH AC CLEAR /RETURN WITH .ASCIZ STRING IN WORD TAD WORDM1 /PT AT WORD (AX) DCA INDEX1 /OUTPUT PTR GETW1, TAD LINPTR /SET ERRCOL TO POINT HERE DCA ERRCOL /IN CASE THIS IS A NASTY WORD TAD I LINPTR /GET CHAR SNA /END OF LINE? JMP I READLN /YES, GET ANOTHER ONE TAD M0241 /SPACE OR CTRL CHAR? SMA JMP GETW2 /NO IAC /SPACE? SZA TAD C0027 /TAB? SZA CLA /YES, ONE OR THE OTHER JMP .+3 /NO, ILLEGAL CHAR ISZ LINPTR /INC PTR (IGNORE) JMP GETW1 /LOOP ERROR /ILLEGAL CHAR TEXT /ILL CHAR/ GETW2, CLA GETW3, TAD I LINPTR /GET CHAR TAD M0241 /CTRL CHAR OR SPACE? SPA CLA JMP GETW4 /YES, GO RETURN TAD I LINPTR /NO, RESTORE CHAR TAD C7405 /CVT LOWER CASE TO [-26.,-1] CLL TAD C0032 /LOWER CASE? SZL CLA /NO, SKIP TAD M0040 /YES, SUBTRACT 32. TAD I LINPTR /GET CHAR BACK DCA I INDEX1 /SAVE ISZ LINPTR /INC PTR JMP GETW3 /LOOP GETW4, DCA I INDEX1 /MARK END WITH <NUL> JMP I GETW /RETURN M0241, -241 /SPACE, CTRL CHARS -> [-32.,-1] C0032, 32 /[-26.,-1] -> [0,25.] (FLIPPING LINK) C7405, 7405 /LOWER CASE -> [-26.,-1] M0040, -40 /LOWER CASE -> UPPER CASE READLN, READL0 /PROMPT, GET A LINE / PAGE / READL0, /CALLS INPUT, AND RESETS LINPTR RUNIMM /RUN IMMEDIATE CODE FIRST TAD PROMPT /PROMPT? SNA CLA JMP READL1 /NO TYPE /YES, PRINT PROMPT "O+40;"K+40;215;212;0 /"OK<CR><LF>" (LOWER CASE) READL1, CMA /REMEMBER TO PROMPT NEXT TIME, ANYWAY DCA PROMPT TAD CLINE /PT AT LINE BUFFER DCA TEMP1 /PUT IN TEMP1 JMS INPUT /READ A LINE TAD CLINE /GET PTR TO LINE DCA LINPTR /PT AT LINE JMP I .+1 /TRY AGAIN GETW+1 / INPUT, 0 /READ 80 CHARS FROM TTY TO @TEMP1 /ENTER WITH AC CLEAR /0 MARKS END OF INPUT STRING TAD TEMP1 /GET START OF BUFFER CIA /NEGATE DCA TEMP2 /USED TO CHECK BEG OF BUFF ON RUBOUT TAD TEMP1 /GET PTR DCA INDEX2 /SAVE IT TAD TEMP1 /GET START OF BUFFER TAD D0080 /PT AT LAST NON-CR CHAR IN BUFFER CIA /NEGATE DCA TEMP3 /USED TO CHECK END OF BUFF ON INSERT DCA DELFLG /NOT BETWEEN \'S INPUT1, KRB /GET A CHAR DCA TEMP4 /SAVE IT TAD NUMSPC /-(NUMBER OF SPECIALLY TREATED CHARS) DCA TEMP5 /LOOP CTR TAD CIDISP /PT AT IDISP (DISP. TABLE) DCA INDEX1 /SAVE TAD TEMP4 /GET CHAR BACK INPUT2, TAD I INDEX1 /IS THIS THE CHAR? SNA /SKIP IF THIS ISN'T IT JMP INPUT5 /THIS IS IT, GO JUMP TO IT ISZ INDEX1 /SKIP OVER ADDR ISZ TEMP5 /DONE? JMP INPUT2 /NO, TRY NEXT VALUE CLA INPUT3, /INSERT AND ECHO CHAR JMS BACKSL /PRINT \ AND CLEAR DELFLG IF DELFLG TAD TEMP1 /GET PTR TAD TEMP3 /OUT OF SPACE? SZA CLA /SKIP IF SO JMP INPUT4 /OTHERWISE CONTINUE TAD C0007 /RING BELL PRINT JMP INPUT1 /AND IGNORE INPUT4, TAD TEMP4 /GET CHAR DCA I TEMP1 /PUT IN BUFFER ISZ TEMP1 /INC PTR JMS I ECHOA /ECHO THE CHAR JMP INPUT1 /LOOP INPUT5, /JUMP TO DISPATCH TABLE ADDRESS CLA /CLEAR AC TAD I INDEX1 /GET DISPATCH VALUE DCA BACKSL /SAVE JMP I BACKSL /JUMP TO IT BACKSL, 0 /IF DELFLG.NE.0, PRINT \ AND CLEAR DELFLG TAD DELFLG /INSIDE \'S? SNA CLA JMP I BACKSL /NO, RETURN DCA DELFLG /CLEAR FLAG TAD .+3 /LOAD "\" PRINT /PRINT IT JMP I BACKSL /AND RETURN "\ /DELIMITS DELETED CHAR'S INPUT6, /MARK END OF STRING AND RETURN JMS BACKSL /"\" IF NESSA DCA I TEMP1 /ZERO AT END CRLF /CR,LF JMP I INPUT /RETURN INPUT7, /^R - CR,LF AND REDRAW STRING JMS BACKSL /"\" IF NESSA JMS I ECHOA /PRINT "^R" CRLF /CR,LF DCA I TEMP1 /MARK END OF STRING, FOR NOW CMA /LOAD -1 TAD INDEX2 /PT AT START OF STRING -1 DCA INDEX3 /SAVE INPUT8, TAD I INDEX3 /GET A CHAR SNA /SKIP IF NOT ZERO JMP INPUT1 /GET ANOTHER CHAR DCA TEMP4 /SAVE THE CHAR JMS I ECHOA /ECHO IT JMP INPUT8 /LOOP UNTIL 0 INPUT9, /^U - CR,LF AND CANCEL STRING JMS I ECHOA /PRINT "^U" CRLF /CR,LF TAD INDEX2 /GET START OF BUFFER DCA TEMP1 /RESET POINTER JMP INPUT1 /GET ANOTHER CHAR "$ INPU10, /ESCAPE - ECHO $ AND RETURN JMS BACKSL /"\" IF NESSA TAD .-2 /GET "$" PRINT /PRINT IT DCA I TEMP1 /MARK END OF STRING JMP I INPUT /AND RETURN / RUBOUT, /RUBOUT - PRINT "\" (IF NESSA) AND ECHO LAST CHAR TAD TEMP1 /GET PTR TAD TEMP2 /GET -(START) SZA CLA /BUFFER EMPTY? JMP RUB1 /NO JMS BACKSL /PRINT CLOSING \ IF NESSA CRLF /YES, CR,LF JMP INPUT1 /AND IGNORE RUB1, TAD DELFLG /NEED A "\" ? SZA CLA JMP RUB2 /NO, ALREADY INSIDE \'S TAD INPUT6-1 /GET \ PRINT /PRINT IT ISZ DELFLG /SET DELFLG RUB2, CMA /BACK UP PTR TAD TEMP1 DCA TEMP1 TAD I TEMP1 /GET CHAR TO BE DELETED DCA TEMP4 /PUT IN CHAR BUFF JMS I ECHOA /ECHO IT TAD TEMP1 /AT BEGN OF BUFF NOW? TAD TEMP2 SZA CLA JMP INPUT1 /NO, LOOP JMS BACKSL /PRINT "\" CRLF /CR,LF JMP INPUT1 /AND DO ANOTHER CHAR ECHOA, ECHO /PTR TO ECHO ROUTINE D0080, 120 /80. (LENGTH OF BUFFER) NUMSPC, -13 /-(NUMBER OF SPECIAL INPUT CHARS) CIDISP, IDISP-1 /PTR TO INPUT DISPATCH TABLE / PAGE / ECHO, 0 /ECHO CHAR IN TEMP4 TAD TEMP4 /GET CHAR AND C7540 /CLEAR AC4,AC7-AC11 SNA CLA /CTRL CHAR? JMP ECHO2 /YES, SPECIAL TREATMENT ECHO1, TAD TEMP4 /GET CHAR PRINT /PRINT IT JMP I ECHO /RETURN ECHO2, TAD TEMP4 /GET CHAR TAD M0211 /TAB? SZA /SKIP IF SO IAC /BACKSPACE? SNA CLA /SKIP IF NOT JMP ECHO1 /HT & BS ARE ECHOED AS-IS TAD UPARR /PRINT "^" PRINT 7203 /CLA IAC BSW (PAL-D BUG) LOAD 64. TAD TEMP4 /LOAD CHAR+64. PRINT /ECHO IT JMP I ECHO /RETURN UPARR, "^ /FOR CTRL CHARS / /DISPATCH TABLE FOR SPECIAL CHARACTERS: IDISP, /INPUT DISPATCH TABLE (RO,ESC,^U,^R,^M,^L,^K,^J,^I,^H,NUL) -377 /RUBOUT RUBOUT 377-233 /ESCAPE INPU10 233-225 /^U INPUT9 225-222 /^R INPUT7 222-215 /CR INPUT6 215-214 /FF INPUT6 214-213 /VT INPUT6 213-212 /LF INPUT6 212-211 /TAB INPUT3 211-210 /BACKSPACE INPUT3 210-200 /NUL INPUT1 /DWEE! / 0 /TEMP BUFFER FOR CHAR PRINT0, 0 /PRINT CHAR IN AC, DEAL WITH TABS DCA PRINT0-1 /SAVE TAD PRINT0-1 /GET BACK TAD M0211 /TAB? SNA JMP TAB /YES, DEAL WITH IT IAC /BACKSPACE? SNA /NO, SKIP JMP BCKSPC /YES, SPECIAL TREATMENT TAD C7773 /CR? SNA CLA JMP CARRET /YES TAD PRINT0-1 /GET CHAR AND C7540 /CTRL CHAR? SZA CLA /SKIP IF SO ISZ PRCOL /OTHERWISE INC PRCOL PRINT1, TAD PRINT0-1 /GET CHAR TLS /PRINT IT CLA /CLEAR AC JMP I PRINT0 /RETURN / BCKSPC, CLL CMA /DEC PRCOL TAD PRCOL SZL /UNLESS IT'S ALREADY 0 (DEC TERMINALS) DCA PRCOL CLA /IN CASE WE JUST SKIPPED JMP PRINT1 /PRINT BS AND RETURN TAB, TAD C0240 /PRINT A SPACE TLS CLA ISZ PRCOL /MOVE OVER A COL TAD PRCOL /GET PRCOL AND C0007 /AT A TAB STOP? SZA CLA /SKIP IF SO JMP TAB /ELSE LOOP JMP I PRINT0 /RETURN CARRET, DCA PRCOL /CLEAR PRINT COLUMN JMP PRINT1 /PRINT CR AND RETURN / C7773, 7773 / CRLF0, 0 /PRINT CR,LF TYPE /A LITTLE SLOW, BUT SO WHAT? 215;212;0 /CR,LF JMP I CRLF0 /RETURN / TYPE0, 0 /PRINT .ASCIZ STRING FOLLOWING "TYPE" TAD I TYPE0 /GET CHAR ISZ TYPE0 /INC PTR SNA /DONE YET? JMP I TYPE0 /YES, RETURN PRINT /NO, PRINT THE CHAR JMP TYPE0+1 /LOOP UNTIL 0 / RPUSH0, 0 /PUSH AC TO RETURN STACK (7600-7777) DCA TYPE0 /SAVE AC TAD SP /GET SP TAD C0200 /STACK FULL? SZA CLA JMP RPUSH1 /NO, GO PUSH ERROR /YES, PRINT MESSAGE TEXT /RSTACK OVERFLOW/ RPUSH1, CMA /DEC SP TAD SP DCA SP TAD TYPE0 /GET AC BACK DCA I SP /PUSH IT JMP I RPUSH0 /RETURN / PAGE / ERROR0, 0 /PRINT TRIMMED ASCII MESSAGE AFTER JMS & ABORT TAD CARETF /PRINT "^"? SNA CLA JMP ERROR3 /NO TAD ERRCOL /GET COLUMN OF ERROR CIA /NEGATE DCA TEMP1 /SAVE TAD CLINE /PT AT LINE DCA TEMP2 /SAVE ERROR1, TAD TEMP1 /DONE? TAD TEMP2 SNA CLA JMP ERROR2 /YES, GO PRINT "^ " TAD I TEMP2 /GET CHAR TAD M0211 /TAB? SZA CLA TAD C0027 /NO, PRINT A SPACE TAD C0211 /YES, PRINT A TAB PRINT /HACK, HACK, HACK ISZ TEMP2 /INC PTR JMP ERROR1 /LOOP ERROR2, TYPE /PRINT "^ " "^;" ;0 ERROR3, STA CLL RAL /LOAD -2 DCA RPOP0 /SAVE LOOP CTR TAD I ERROR0 /GET CHAR BSW /GET HIGH CHAR ERROR4, AND C0077 /MASK OUT HIGH BITS SNA /DONE? JMP ERROR6 /YES, CR/LF AND RESTART DCA LOOKU0 /NO, SAVE THE CHAR TAD LOOKU0 /GET BACK CMA /FLIP EVERYTHING AND C0040 /BIT 6 SET? CLL RAL /HACK HACK HACK TAD C0200 /ADD MISSING BITS TAD LOOKU0 /GET CHAR BACK PRINT /PRINT IT ISZ RPOP0 /WAS THAT THE HIGH OR THE LOW CHAR? JMP ERROR5 /HIGH ISZ ERROR0 /LOW - PT TO NEXT CHAR JMP ERROR3 /DO THE NEXT TWO CHARS ERROR5, TAD I ERROR0 /GET LOW CHAR JMP ERROR4 /PRINT IT ERROR6, CRLF /CR,LF DCA PROMPT /NOT "OK" JMP RESET /GO RESTART C0040, 40 C0211, 211 /TAB / LOOKU0, 0 /LOOK UP WORD IN WORD BUFFER /RETURN WITH LINK CLEAR AND TEMP1 POINTING AT TYPE IF /FOUND, OR WITH LINK SET IF NOT FOUND. TAD CDICT /PT AT DICT DCA TEMP1 DCA TEMP2 /PTR TO LAST LINK (FORGET) LOOKU1, TAD WORDM1 /#WORD -1 DCA INDEX1 /SOURCE PTR (AX) LOOKU2, CMA CLL RAL /LOAD -2 (2 CH'S/WORD) DCA TEMP3 /LOOP CTR TAD I TEMP1 /GET 2 CHARS BSW /LOOK AT HIGH ORDER FIRST LOOKU3, AND C0077 /REMOVE HIGH CHAR SNA /END OF ENTRY? JMP LOOKU5 /YES, SEE IF END OF WORD TAD C0240 /CVT TO ASCII CIA /NEGATE TAD I INDEX1 /=? SZA CLA JMP LOOKU6 /NO, SKIP TO LINK ISZ TEMP3 /FINISHED WORD? JMP LOOKU4 /NO, CHECK LOW CHAR ISZ TEMP1 /YES, PT AT NEXT PAIR OF CHARS JMP LOOKU2 /LOOP LOOKU4, TAD I TEMP1 /GET PAIR OF CHARS BACK JMP LOOKU3 /CHECK LOW CHAR LOOKU5, TAD I INDEX1 /END OF WORD? SZA CLA JMP LOOKU6 /NO, SKIP TO NEXT ENTRY ISZ TEMP1 /YES, PT AT LINK ISZ TEMP1 /PT AT TYPE CLL /SIGNIFY FOUND JMP I LOOKU0 /RETURN LOOKU6, TAD I TEMP1 /GET CHAR ISZ TEMP1 /PT AT NEXT CHAR OR LINK AND C0077 /BOTTOM BYTE SHOULD BE 0, ANYWAY SZA CLA /IS IT? JMP LOOKU6 /NO, TRY NEXT WORD TAD TEMP1 /YES, GET PTR TO LINK DCA TEMP2 /SAVE IN CASE OF <FORGET> TAD I TEMP1 /GET LINK STL /IN CASE THIS IS THE END OF THE DICT SNA /IS IT? JMP I LOOKU0 /YES, RETURN, LINK SET DCA TEMP1 /NO, PT TO NEXT NAME FIELD JMP LOOKU1 /CHECK THIS ENTRY CDICT, DICT /BEGINNING OF DICTIONARY / DCTVA0, 0 /PUT AC IN DICTIONARY, ADVANCE DP (CHECK PSTACK) DCA I DP /THERE IS ALWAYS AT LEAST 1 FREE WORD TAD DP /GET DP CMA /NEGATE, SUBTRACT 1 (HACK HACK) TAD PSP /PSTACK COLLISION? SZA CLA JMP DCTVA1 /NO ERROR /YES, ERROR TEXT /DICT FULL/ DCTVA1, ISZ DP /ALL OK, INC DP JMP I DCTVA0 /RETURN, AC CLEAR / DCTCO0, 0 /PUT WORD AFTER JMS IN DICT, ADVANCE DP CLA TAD I DCTCO0 /GET WORD TO PUT JMS DCTVA0 /PUT IT IN THE DICT ISZ DCTCO0 /PT PAST ARG JMP I DCTCO0 /RETURN, AC CLEAR / PAGE / MAKEW0, 0 /CREATE ENTRY FOR WORD IN WORD BUF IN DICT /FIRST, CHECK TO MAKE SURE THE WORD DOESN'T ALREADY EXIST. /USE TYPE IN WORD FOLLOWING JMS. JMS I LOOKUP /TRY TO LOOK THE WORD UP SZL /SKIP IF FOUND JMP MAKEW1 /NOT THERE, MAKE IT ERROR /ALREADY DEFINED TEXT /ILL REDEF'N/ MAKEW1, TAD TEMP2 /GET PTR TO LINK IN LAST ENTRY DCA SMUDGE /SAVE IN CASE OF COMPILATION ERROR TAD WORDM1 /PT AT WORD DCA INDEX1 /SOURCE PTR MAKEW2, CMA CLL RAL /-2 DCA TEMP1 /LOOP CTR MAKEW3, TAD I INDEX1 /GET A CHAR SNA /END? JMP MAKEW6 /YES, FINISH OFF TAD M0240 /NO, CVT TO SIXBIT DCA TEMP2 /SAVE TAD TEMP2 /CHECK AND C7700 /ANY EXTRA BITS? SNA CLA JMP MAKEW4 /OK, CONTINUE ERROR /ILLEGAL NAME TEXT /ILL NAME/ MAKEW4, TAD TEMP2 /GET CHAR ISZ TEMP1 /CHAR 1, OR 2? JMP MAKEW5 /1 TAD TEMP3 /2 - GET OLD CHAR DCTVAL /COMPILE INTO DICTIONARY JMP MAKEW2 /LOOP MAKEW5, BSW /LEFT 6 BITS DCA TEMP3 /SAVE JMP MAKEW3 /LOOP MAKEW6, /END OF WORD ISZ TEMP1 /CHAR 1, OR 2? SKP /1 - PUT 0,0 TAD TEMP3 /2 - PUT CHAR,0 DCTVAL /COMPILE LAST WORD OF NAME DCTVAL /LINK IS 0 TAD I MAKEW0 /GET TYPE DCTVAL /COMPILE IT ISZ MAKEW0 /SKIP OVER TYPE JMP I MAKEW0 /RETURN C7700, 7700 /CLEAR OUT CHAR M0240, -240 /CONVERT ASCII TO SIXBIT / PUTVA0, 0 /PUT AC IN DICT OR IMMBUF, DEPENDING ON INWORD DCA MAKEW0 /SAVE AC TAD INWORD /IN A : DEFN? SNA CLA /SKIP IF SO JMP PUTVA1 /ELSEWISE, GO PUT IN ICODE TAD MAKEW0 /GET AC DCTVAL /SAVE IN DICT JMP I PUTVA0 /RETURN PUTVA1, TAD IMMDP /GET IMMEDIATE PSEUDO-DICTIONARY PTR TAD PUTVA3 /ICODE FULL? SZA CLA /YES, ERROR JMP PUTVA2 /NO, POKE THE VALUE ERROR TEXT /IMM BUFF FULL/ PUTVA2, TAD MAKEW0 /GET AC DCA I IMMDP /PUT IN ICODE ISZ IMMDP /INC PTR JMP I PUTVA0 /RETURN PUTVA3, -ICODE-176 /ALWAYS LEAVE ONE EXTRA WORD FOR "RET" / PUTCO0, 0 /PUT WORD AFTER JMS IN APPROPRIATE BUFFER CLA TAD I PUTCO0 /GET WORD JMS PUTVA0 /POKE TO BUFFER ISZ PUTCO0 /INC PTR JMP I PUTCO0 /RETURN / JUMP0, 0 /JUMP TO ADDR AFTER JMS CLA TAD I JUMP0 /GET ADDR DCA JUMP0 /SAVE JMP I JUMP0 /JUMP TO IT / CALL0, 0 /CALL ADDR FOLLOWING "CALL," USING RSTACK CLA IAC /LOAD 1 TAD CALL0 /RETURN ADDRESS RPUSH /PUSH TO RSTACK TAD I CALL0 /GET ADDR TO CALL DCA CALL0 /SAVE JMP I CALL0 /JUMP TO IT / RET0, /POP PC OFF OF RSTACK RPOP /GET RETURN ADDRESS DCA CALL0 /SAVE JMP I CALL0 /JUMP TO IT / PPUSH0, 0 /PUSH AC TO PSTACK DCA CALL0 /SAVE AC CMA /DEC PSP TAD PSP DCA PSP TAD DP /PSP-DP-1=0? CMA TAD PSP SZA CLA JMP PPUSH1 /NO, EVERYTHING'S HIP ERROR TEXT /PSTACK OVERFLOW/ PPUSH1, TAD CALL0 /RESTORE AC DCA I PSP /PUSH IT JMP I PPUSH0 / PAGE / PPOP0, 0 /POP AC FROM PSTACK CLA TAD PSP /GET PSP TAD C0200 /PSP=7600? SZA CLA JMP PPOP1 /NO ERROR TEXT /PSTACK UNDFL/ PPOP1, TAD I PSP /POP A VALUE ISZ PSP /INC PSP JMP I PPOP0 /RETURN / RPOP0, 0 /POP AC FROM RETURN STACK (7600-7777) TAD SP /GET SP SZA CLA JMP RPOP1 /STACK OK, GO POP ERROR /UNDERFLOW, PRINT ERROR TEXT /RSTACK UNDFL/ RPOP1, TAD I SP /GET AC ISZ SP /INC SP NOP /THIS WILL SKIP ON THE LAST WORD JMP I RPOP0 /RETURN / PPC0, 0 /PPUSH CONSTANT IN LOCN AFTER "PPUSHC" CLA TAD I PPC0 /GET CONSTANT PPUSH /PPUSH IT ISZ PPC0 /INC PAST ARG JMP I PPC0 /RETURN / RUNIM0, 0 /RUN IMMEDIATE CODE TAD INWORD /COMPILING A : DEFN? SZA CLA JMP IMM1 /YES, DON'T WORRY ABOUT NESTING TAD NLEVEL /NLEVEL=NSP? CIA TAD NSP SNA CLA JMP IMM1 /YES, NO PROBLEM ERROR /NO, GACK TEXT /UNCLOSED STRUC/ IMM1, DCA CARETF /NO "^" ON RUN-TIME ERRORS TAD CRET /"RET" AT END OF IMM CODE DCA I IMMDP CALL /CALL THE CODE ICODE TAD CICODE /PT AT ICODE DCA IMMDP /RESET IMMDP CMA /^ ON ERRORS DCA CARETF JMP I RUNIM0 /RETURN CRET, RET CICODE, ICODE / NPUSH0, 0 /PUSH AC, @PC TO NESTING STACK DCA RPOP0 /SAVE AC TAD NSP /GET NSTACK PTR TAD NPUSH2 /STACK FULL? SZA CLA JMP NPUSH1 /NO ERROR /YES, ERROR TEXT /TOO MUCH NESTING/ NPUSH1, TAD NSP /GET OFFSET TAD CNSTAK /ADD BASE DCA PPC0 /SAVE PTR TAD RPOP0 /GET ADDRESS BACK DCA I PPC0 /PUSH IT ISZ PPC0 /INC PTR ISZ NSP /INC OFFSET TAD I NPUSH0 /GET KEYWORD TOKEN DCA I PPC0 /PUSH IT ISZ NSP /INC OFFSET (NOT PTR) ISZ NPUSH0 /SKIP OVER ARG JMP I NPUSH0 /RETURN NPUSH2, -40 /STACK BIG ENOUGH FOR 16 LEVELS OF NESTING CNSTAK, NSTACK /PTR TO BASE OF NSTACK / PAGE / NPOP0, 0 /POP AC OFF OF NESTING STACK /CHECK TO SEE IF TOKEN AGREES WITH ONE AFTER CALL (NEGATIVE) CLA /JUST TO MAKE SURE TAD NSP /GET NSTACK PTR SZA /SKIP IF EMPTY JMP NPOP1 /OTHERWISE START THE POP ERROR /NO MATCHING NPUSH TEXT /STRUC ERR/ NPOP1, TAD NSTAK1 /ADD BASE TO OFFSET DCA TEMP5 /SAVE THIS PTR TAD I TEMP5 /GET TOKEN TAD I NPOP0 /GET -TOKEN TO MATCH SNA CLA /DO THEY MATCH? JMP NPOP2 /YES ERROR /NO TEXT /NEST ERR/ NPOP2, STA CLL RAL /-2 TAD NSP /DEC NSP BY 2 DCA NSP STA /DEC PTR BY 1 TAD TEMP5 DCA TEMP5 TAD I TEMP5 /GET ADDRESS ISZ NPOP0 /SKIP OVER TOKEN JMP I NPOP0 /RETURN NSTAK1, NSTACK-1 / CURRD0, 0 /RETURN DP FOR CURRENT BUFFER CLA /JUST MAKING SURE TAD INWORD /IN A COLON DEFINITION? SZA CLA JMP .+3 /YES TAD IMMDP /NO JMP I CURRD0 /RETURN TAD DP /GET DICTIONARY POINTER JMP I CURRD0 /RETURN / /DATA AREAS NSTACK= . /NESTING STACK *.+40 /ALLOW 16. LEVELS OF NESTING WORD= . /BUFFER FOR WORD *.+40 /ALLOW 32. CHARS BEFORE HITTING LINE LINE= . /BUFFER FOR INPUT LINE *.+120 /ALLOW 80 CHARS ICODE= . /BUFFER FOR IMMEDIATE MODE CODE *.+200 /ALLOW A LOT OF THAT DICT= . /START OF PREDEFINED DICTIONARY / 0100 /! PAREN TSUBR /( VAL ADDR -- ) POKES ADDR TO VAL PPOP /GET ADDRESS DCA TEMP1 /SAVE PPOP /GET VALUE DCA I TEMP1 /POKE RET /RETURN / PAREN, 1000 /( MULT TSTRU /( -- TEXT ')') IGNORES TEXT TO NEXT ")" CLA PAREN1, TAD I LINPTR /LOOK FOR ")" ISZ LINPTR /PT AT NEXT CHAR SNA /END OF LINE? JMP PAREN2 /YES, GO READ ANOTHER ONE (BIG COMMENT) TAD PAREN3 /")" ? SZA CLA JMP PAREN1 /NO, LOOP RTS /YES, RETURN PAREN2, TAD CLINE /PT AT LINE BUFF DCA TEMP1 /SAVE PTR FOR INPUT JMS I PAREN4 /CALL INPUT TAD CLINE /PT AT LINE, AGAIN DCA LINPTR /SET LINPTR TO POINT THERE JMP PAREN1 /SEARCH LINE FOR ")" PAREN3, -") /SEARCH CHARACTER PAREN4, INPUT / MULT, 1200 /* PLUS TSUBR PPOP /GET FIRST VALUE DCA TEMP1 /SAVE IT PPOP /GET SECOND VALUE DCA TEMP2 /SAVE IT JMS MULT0 /PERFORM THE MULTIPLY TAD TEMP4 /GET THE PRODUCT PPUSH /RETURN IT RET / MULT0, 0 /MULTIPLY TEMP1 BY TEMP2, RESULT IN TEMP4 TAD M0014 /-12. DCA TEMP3 /BIT COUNTER DCA TEMP4 /ACCUMULATOR MULT1, TAD TEMP1 /GET MULTIPLIER RAR /AC11 INTO LINK DCA TEMP1 /SAVE RESULT SNL /SKIP IF 1 JMP MULT2 /0, DON'T ADD TAD TEMP4 /GET ACCUMULATOR TAD TEMP2 /ADD MULTIPLICAND DCA TEMP4 /SAVE SUM MULT2, TAD TEMP2 /ROTATE MULTIPLICAND LEFT ONE BIT CLL RAL DCA TEMP2 ISZ TEMP3 /DONE ALL 12. BITS? JMP MULT1 /NO, LOOP JMP I MULT0 /YES, RETURN (RESULT IN TEMP4) M0014, -14 /-(NUMBER OF BITS IN A WORD) / PLUS, 1300 /+ COMMA TSUBR ( VAL1 VAL2 -- VAL1+VAL2) RETURNS SUM OF TOP TWO VALUES PPOP /GET FIRST VALUE DCA TEMP1 /SAVE IT PPOP /GET SECOND VALUE TAD TEMP1 /ADD FIRST VALUE PPUSH /PUSH SUM RET / COMMA, 1400 /, MINUS TSUBR ( VALUE -- ) PUTS VALUE INTO DICTIONARY AND ADVANCES DP PPOP /GET VALUE DCTVAL /POKE INTO DICTIONARY RET / MINUS, 1500 /- DOT TSUBR ( VAL1 VAL2 -- VAL1-VAL2) RETURNS DIFFERENCE BETWIXT TOP TWO VALUES PPOP /GET VAL1 DCA TEMP1 /SAVE PPOP /GET VAL2 CIA /NEGATE TAD TEMP1 /ADD VAL1 PPUSH /PUSH RESULT RET / DOT, 1600 /. DOTQ TSUBR ( VAL -- ) PRINTS VALUE ON TOP OF STACK, SIGNED PPOP /GET VALUE JMS .+2 /PRINT THE VALUE RET /RETURN / PRNUM0, 0 /PRINT SPACE, AC (SIGNED) SMA /NEGATIVE? JMP PRNUM1 /NO CIA /MAKE POSITIVE DCA TEMP1 /SAVE TYPE /PRINT " -" " ;"-;0 JMP PRNUM2 /GO PRINT THE # PRNUM1, DCA TEMP1 /SAVE NUMBER TYPE /PRINT " " " ;0 PRNUM2, TAD TEMP1 /GET NUMBER BACK JMS I PRNUM3 /PRINT IT RET /AND RETURN PRNUM3, UPRNUM /ROUTINE TO PRINT A #, UNSIGNED / *. /TO AVOID "PE" ERRORS (PAL-D BUG) DOTQ, 1602 /." 0000 DIVD TSTRU /SPECIAL CASE COMPILATION PUTCON /COMPILE "DOTQUO" DOTQUO JMS ASCIZ0 /COMPILE IN-LINE .ASCIZ CONSTANT RTS / ASCIZ0, 0 /COMPILE IN-LINE STRING TERMINATED WITH " TAD I LINPTR /END OF LINE HERE? SNA CLA /NO JMP ASCIZE /YES, ERROR (UNTERMINATED) ASCIZ1, ISZ LINPTR /PT AT NEXT CHAR TAD I LINPTR /GET A CHAR (LOWER CASE OK) SNA /SHOULDN'T BE END OF LINE JMP ASCIZE /ERROR IF SO TAD ASCIZ3 /END OF STRING? SNA CLA JMP ASCIZ2 /YES, <NUL> AT END AND RETURN TAD I LINPTR /NO, RESTORE CHAR PUTVAL /PUT IN DICTIONARY JMP ASCIZ1 /LOOP ASCIZ2, ISZ LINPTR /SKIP OVER " PUTVAL /COMPILE A <NUL> RTS /AND RETURN ASCIZ3, -242 /QUOTE ASCIZE, ERROR /ERROR IF END OF LINE ENCOUNTERED TEXT /NO CLOSING "/ / DOTQU0, 0 /RUN-TIME ROUTINE TO PRINT .ASCIZ STRING FOLLOWING CALL CLA /JUST TO MAKE SURE DOTQU1, TAD I DOTQU0 /GET A CHAR ISZ DOTQU0 /PT AT NEXT ONE SNA /DONE? JMP I DOTQU0 /YES, RETURN PRINT /NO, PRINT THE CHAR JMP DOTQU1 /LOOP UNTIL 0 / DIVD, 1700 /"/" /ADD THIS LATER USRDCT= . /USER-DEFINED WORDS START HERE $ THAT'S ALL, FOLKS!
| | | | |
_________________ iLavr
|
17 May 2020 22:07 |
|
|
shoorick
Doomed
Joined: 05 Nov 2007 05:08 Posts: 487 Location: Украина
|
тем временем у меня в подсознании вырисовался механизм LEAVE, но не просто описать. в двух словах: DO - LEAVE - ...- LEAVE - LOOP должны формировать цепочку с переходами через друг друга в оба направления.
|
18 May 2020 00:52 |
|
|
b2m
Devil
Joined: 26 May 2003 06:57 Posts: 863
|
Всё бы хорошо, но если LEAVE стоит внутри IF (или даже вложенных) то при компиляции невозможно найти в стеке адрес неразрешённой ссылки. А всё потому, что форт Шихова не кладёт в стек тип управляющей конструкции (IF, DO или что-то ещё). Другие форты это делают. Можно отказаться от того, что по LEAVE цикл завершается немедленно. Обычно LEAVE стоит внутри условного оператора и можно оформить цикл следующим образом: В таких условиях реализация LEAVE очень простая: Однако в форте Шихова нет R> и >R. Но их можно реализовать. Обычно эти слова не являются компилирующими, однако в режиме интерпретации от них толку мало. Поэтому с целью оптимизации можно сделать их компилирующими. Однако в форте Шихова нет [']. Это слово компилирует константу, соответствующую CFA следующего за ним слова. Можно конечно заменить ['] DROP на число (адрес CFA DROP), но это не комильфо. Поэтому это слово тоже можно реализовать: И пара слов про IMMEDIATE. Шихов почему-то в своём примере реализовал его нестандартно, оно требует указать слово, которое объявляется исполнимым немедленно. В других версиях форта подразумевается последнее созданное слово. Т.е. можно сделать так: Итого имеем такой пример: | | | | Code: HEX : IMMEDIATE 1046 @ 2 + BEGIN DUP C@ 80 < IF 1 + REPEAT DUP C@ 40 OR SWAP C! ; : ['] [ ' DUP DUP CD C, , 1 C, , ] CD C, , 1 C, ' , ; IMMEDIATE : >R CDC5 , ['] DROP , ; IMMEDIATE : R> CD C, ['] DUP , C1 C, ; IMMEDIATE : LEAVE R> R> R> DROP DUP >R >R >R ; : TEST 5 1 1 +DO 31 EMIT I 3 = IF LEAVE ELSE 32 EMIT THEN REPEAT ; | | | | |
_________________Страничка эмулятора наших компьютеров
http://bashkiria-2m.narod.ru/
Last edited by b2m on 18 May 2020 05:13, edited 1 time in total.
|
18 May 2020 05:01 |
|
|
b2m
Devil
Joined: 26 May 2003 06:57 Posts: 863
|
Это были примеры полезных слов, но гораздо проще реализовать LEAVE как компилирующее слово:
_________________Страничка эмулятора наших компьютеров
http://bashkiria-2m.narod.ru/
|
18 May 2020 05:05 |
|
|
b2m
Devil
Joined: 26 May 2003 06:57 Posts: 863
|
Всё-таки добил я LEAVE до нужного состояния: Но это только для данной версии форта Шихова, в которой адрес одной из п/п 0DD8, а дно стека 1080.
_________________Страничка эмулятора наших компьютеров
http://bashkiria-2m.narod.ru/
|
18 May 2020 06:37 |
|
|
b2m
Devil
Joined: 26 May 2003 06:57 Posts: 863
|
Кстати, если хочется иметь CONTINUE, то можно и так:
_________________Страничка эмулятора наших компьютеров
http://bashkiria-2m.narod.ru/
|
18 May 2020 10:27 |
|
|
Lavr
Supreme God
Joined: 21 Oct 2009 08:08 Posts: 7777 Location: Россия
|
Почитал я исходник этот внимательно - похоже на правду, хотя и не закончено по словам автора: Интересно было, как реализуют стековый язык на принципиально бесстековой машине... Но на активные поиски версии Forth для PDP-8 меня сподвинул несколько другой факт. Серьёзная и известная леди из FORTH Inc. утверждала, что версия FORTH для PDP-8 существовала: | | | | FORTH, Inc. experimented briefly with <16-bit Forths in the 70's. We had a 12-bit PDP-8 system that was used in a couple of applications, and briefly flirted with an 8-bit version when the first microprocessors came out. But it was really not usable, and I think everyone else pretty much came to the same conclusion. ... Cheers, Elizabeth -- ================================================== Elizabeth D. Rather (US & Canada) 800-55-FORTH FORTH Inc. +1 310.999.6784 5959 West Century Blvd. Suite 700 Los Angeles, CA 90045 http://www.forth.com"Forth-based products and Services for real-time applications since 1973." ================================================== | | | | |
Но следов этой версии Forth-а мне нигде разыскать не удалось... Впрочем, как мне кажется, для удовлетворения любопытства имеющегося кода достаточно. Хотя запустить Forth на эмуляторе PDP-8 хотелось, конечно же...
_________________ iLavr
|
19 May 2020 08:58 |
|
|
Lavr
Supreme God
Joined: 21 Oct 2009 08:08 Posts: 7777 Location: Россия
|
Тяжко этот исходник собирается... Оказалось, написан он под PAL-D, и кроссассемблеры, ориентированные на PAL-8 некоторые слова в упор не понимают. Ниже список таких слов: OTHER RESIDENT IOTS Другой неприятный момент в том, что если что-то собиралось под PAL-D, то и работало оно скорее всего на PDP-8/I под OS TSS/8. А для неё требования к системе весьма нехилые: не менее 12288 слов памяти, из которых первые 8192 слов предназначались для размещения программ монитора операционной системы, а оставшиеся 4096 слов разделялись между пользователями системы. Это далеко не всякий эмулятор сумеет... По тексту также включены некоторые фрагменты для подавления ошибок PAL-D... Но... будем посмотреть...
_________________ iLavr
|
22 May 2020 13:13 |
|
|
b2m
Devil
Joined: 26 May 2003 06:57 Posts: 863
|
Я собирал вот этим кросс-ассемблером: https://github.com/lisper/cpus-pdp8/tre ... tils/macroДействительно, он не знает слова из приведённого выше списка, он ставит вместо них нули, что вобщем-то не страшно. Хотя я заменил эти команды на NOP. Ну и чтобы запустить этот форт, традиционно допилил свой эмулятор:
_________________Страничка эмулятора наших компьютеров
http://bashkiria-2m.narod.ru/
|
22 May 2020 13:40 |
|
|
b2m
Devil
Joined: 26 May 2003 06:57 Posts: 863
|
Странно, что вычитает он в другом порядке. Но этот форт вообще недоделан. Как видно из исходника, последнее слово, которое начал писать Джон - это деление. Но процедуру деления он не сделал. А эта процедура нужна, чтобы сделать вывод числа на экран. Слово "точка" есть, но ссылается на неопределённую процедуру UPRNUM. Да и вывод текстовой строки тоже пришлось допиливать - DOTQUO тоже не определено, хотя и можно добавить его на нулевую страницу (не путать О и ноль): Но лично я использовал вместо этого TYPE, процедура полностью аналогична, разве что не чистит AC в начале. Я вот взял и просто добавил CLA в начало TYPE. Слово "двоеточие" для создания других слов он тоже не сделал. Хотя некоторые нужные для него процедуры уже есть: MAKEW0, неизвестно только, есть ли в ней ошибки. -------- А вот что удивило, так это то, что вводимый с клавиатуры текст (в терминах других фортов - в режиме интерпретации) тоже компилируется и выполняется перед вводом следующей строки. То есть тут как-бы нет режима интерпретации. Но есть переключатель, куда компилировать - в словарь, или во временный буфер, который и исполняется по вводу строки. Причём, как компилировать слово - определяет само слово. После того, как вводимое слово найдено в словаре, запускается код, адрес которого указан после имени. Получается путаница - то-ли это интерпретация, то-ли компиляция. Можно сказать, это интерпретация, результат которой - скомпилированный код. Что касается скомпилированного кода - то это подпрограммный шитый код. Тут ничего необычного. Разве что тот факт, что в PDP-8 нет аппаратного стека, все стеки реализованы программно.
_________________Страничка эмулятора наших компьютеров
http://bashkiria-2m.narod.ru/
|
22 May 2020 14:13 |
|
|
Lavr
Supreme God
Joined: 21 Oct 2009 08:08 Posts: 7777 Location: Россия
|
Собственно, именно это и интересно! А там где есть и аппаратный стек, и развитая косвенная адресация (как в z80) - там удивляться особо нечему... А что у тебя скомпилировалось по адресам, выделенным красным, тоже нули?
_________________ iLavr
|
22 May 2020 15:54 |
|
|
b2m
Devil
Joined: 26 May 2003 06:57 Posts: 863
|
Да, но эти слова всё равно не реализованы и не используются. forth.err forth.lst
_________________Страничка эмулятора наших компьютеров
http://bashkiria-2m.narod.ru/
|
23 May 2020 04:54 |
|
|
Who is online |
Users browsing this forum: No registered users and 82 guests |
|
You cannot post new topics in this forum You cannot reply to topics in this forum You cannot edit your posts in this forum You cannot delete your posts in this forum You cannot post attachments in this forum
|
|