% ********************************************************* % * * % * PISTOL-Portably Implemented Stack Oriented Language * % * Version 1.3 * % * (C) 1982 by Ernest E. Bergmann * % * Physics, Building #16 * % * Lehigh Univerisity * % * Bethlehem, Pa. 18015 * % * * % * Permission is hereby granted for all reproduction and * % * distribution of this material provided this notice is * % * is included. * % * * % ********************************************************* % BASIC DEFINITIONS IN PISTOL FOR PISTOL- "PBASE" % FEBRUARY 6, 1982, RECURSE DEF. FIXED % DECIMAL mode initially -6 W * USER + W@ W@ % used for 'LAST-PRIMITIVE 'W* W 1 - IF : W * ; ELSE $: ;$ THEN 'USER+ USER IF $: USER + ;$ ELSE $: ;$ THEN 'TRANS $: W* USER+ ;$ % TRANSLATES LOGICAL ADDRESSES TO ACTUAL % RAM ADDR. % TRANS MUST USE "$:" FOR THE 'DIS PACKAGE 'TRANS@ : TRANS W@ ; 'ARGPATCH : -6 TRANS@ W@ W + W! ; % for 'CONSTANT 'VARIABLE, % and 'ARRAY 'CONSTANT : : 0 ; ARGPATCH ; 'LAST-PRIMITIVE CONSTANT -1 'TRUE CONSTANT 0 'FALSE CONSTANT -57 TRANS@ 'MAXLINNO CONSTANT -56 TRANS@ 'CHKLMT CONSTANT -55 TRANS@ 'RAMMIN CONSTANT -54 TRANS@ 'STRINGSMIN CONSTANT % -53 TRANS NOT CURRENTLY BEING USED -52 TRANS 'ABORT-PATCH CONSTANT -51 TRANS 'CONVERT-PATCH CONSTANT -50 TRANS 'PROMPT-PATCH CONSTANT -49 TRANS@ 'STRINGSMAX CONSTANT -48 TRANS@ 'VBASE CONSTANT -47 TRANS@ 'VSIZE CONSTANT VBASE VSIZE W* + 'VMAX CONSTANT -46 TRANS@ 'CSIZE CONSTANT -45 TRANS@ 'LSIZE CONSTANT -44 TRANS@ 'RSIZE CONSTANT -43 TRANS@ 'SSIZE CONSTANT -42 TRANS@ 'LINEBUF CONSTANT LINEBUF 200 + 'EDITBUF CONSTANT -41 TRANS@ 'COMPBUF CONSTANT -40 TRANS@ 'RAMMAX CONSTANT -39 TRANS@ 'MAXORD CONSTANT -38 TRANS@ 'MAXINT CONSTANT % -37 TRANS NOT CURRENTLY BEING USED -36 TRANS@ 'VERSION CONSTANT 'ON : TRUE SWAP W! ; 'OFF : FALSE SWAP W! ; 'INFILE : -11 TRANS@ ; 'BYE : -35 TRANS ON ; -34 TRANS '(PISTOL<) CONSTANT -32 TRANS '.V CONSTANT -29 TRANS 'LOADFILE-STATUS CONSTANT -28 TRANS '#GET-ADDR CONSTANT % FOR PATCHING #GETLINE -27 TRANS 'TAB-SIZE CONSTANT -26 TRANS 'TRACE-ADDR CONSTANT -25 TRANS 'ENDCASE-PATCH CONSTANT -24 TRANS 'COLUMN CONSTANT -23 TRANS 'TERMINAL-WIDTH CONSTANT -22 TRANS '#LINES CONSTANT -21 TRANS 'TERMINAL-PAGE CONSTANT -20 TRANS 'COMPILE-END-PATCH CONSTANT -19 TRANS 'TRACE-LEVEL CONSTANT % USED AS BOOLEAN AND LEVEL % INDICATOR -17 TRANS 'RAISE CONSTANT -15 TRANS 'NEXTCH^ CONSTANT -14 TRANS 'CONSOLE CONSTANT -13 TRANS 'ECHO CONSTANT -12 TRANS 'LIST CONSTANT -6 TRANS 'CURRENT CONSTANT -5 TRANS 'OLD-EOSTRINGS CONSTANT % END OF PERMANENT STRINGS % VARIABLE -4 TRANS 'CURRENT-EOSTRINGS CONSTANT -3 TRANS '.D CONSTANT -2 TRANS '.C CONSTANT -1 TRANS 'RADIX CONSTANT STRINGSMIN 'RADIX-INDICATOR CONSTANT STRINGSMIN 1 + 'SYNTAXBASE CONSTANT 'NOP : ; 'DUP : 0 S@ ; '1+ : 1 + ; '1- : 1 - ; 'W+ : W + ; 'W- : W - ; 'W<- : SWAP W! ; '1+W! : DUP W@ 1+ W<- ; 'W+W! : DUP W@ W+ W<- ; 'CR : 13 TYO ; 'SPACE : 32 TYO ; 'SPACES : 0 DO SPACE LOOP ; 'DDUP : 1 S@ 1 S@ ; 'OVER : 1 S@ ; '2OVER : 2 S@ ; '3OVER : 3 S@ ; % USED BY DIS PACKAGE(DON'T CHANGE!) 'UNDER : SWAP DROP ; 'TYPE : 0 DO DUP C@ TYO 1+ LOOP DROP ; 'LT : SWAP GT ; 'LINE-SPACE? : COLUMN W@ + TERMINAL-WIDTH W@ LT IF ELSE CR THEN ; 'MSG : DUP C@ LINE-SPACE? DUP 1+ SWAP C@ TYPE ; 'IFCR : COLUMN W@ 0 GT IF CR THEN ; 'ERR : IFCR ABORT ; 'MERR : CONSOLE ON MSG ERR ; 'INDENT : DUP TERMINAL-WIDTH W@ LT IF COLUMN W@ - SPACES ELSE IFCR DROP THEN ; 'TAB : 9 TYO ; 'TABS : 0 DO TAB LOOP ; 'ALLOT : W* .D W@ + .D W! ; % advances dictionary pointer % by the amount given by top of stack 'W, : % PLACES TOS AT END OF DICTIONARY .D W@ W! 1 ALLOT ; 'VARIABLE : : 3 ; % create definition .D W@ ARGPATCH % point it at end of dictionary W, % initialize variable ; % finish with allocating space 'ARRAY : : 3 ; % create definition .D W@ ARGPATCH % point it at end of dictionary ALLOT ; % allocate requested space and ; % VOCABULARY RELATED DEFINITIONS: '> : .V W@ DUP VBASE GT % "POPS" VOCABULARY STACK IF W- .V W! ELSE "*** VSTACK UNDERFLOW***" MERR THEN ; ' : -1 SWAP BEGIN RADIX W@ /MOD SWAP DUP NOT END DROP ; '#TYPE : BEGIN DUP -1 GT IF ASCII TYO REPEAT DROP ; '= : DUP 0 LT IF 45 TYO MINUS THEN #TYPE ; '? : W@ = ; % BELOW ARE WORDS THAT CONTROL DISPLAY OF CODE PRODUCED % BY THE COMPILER; CAN BE USEFUL FOR DEBUGGING AND EDUCATION 'CODESHOW : IFCR "COMPILE BUFFER CONTAINS:" MSG CR COMPBUF BEGIN DUP ? TAB W+ .C W@ OVER GT NOT END DROP IFCR ; 'SHOWCODE : 'CODESHOW FIND COMPILE-END-PATCH W! ; % SHOWCODE SHOULD NOT BE CHANGED WITHOUT CHECKING 'DIS PACKAGE 'NOSHOWCODE : COMPILE-END-PATCH OFF ; 'PROMPT : % DUPLICATES PRIMITIVE PROMPT IFCR % FUNCTION SP IF SP = THEN % EXCEPT STACK SIZE SHOWN RADIX-INDICATOR C@ TYO SYNTAXBASE MSG "> " MSG ; 'PROMPT FIND PROMPT-PATCH W! % PATCHING IT 0 'FENCE VARIABLE 'ADDRESS : DUP FIND DUP IF UNDER ELSE IFCR 39 TYO DROP MSG " NOT FOUND" MERR THEN ; 'FORGET : ADDRESS DUP FENCE W@ GT IF % ADDRESS OK, SO TRUNCATE EVERYTHING: DUP W- W- W@ DUP OLD-EOSTRINGS W! CURRENT-EOSTRINGS W! W- W- W- DUP W@ CURRENT W@ W! W- .D W! ELSE % ADDRESS BELOW FENCE "BELOW FENCE" MERR THEN ; % PROTECT 'FORGET WITH THE FENCE: 'FORGET FIND FENCE W! '/ : /MOD DROP ; 'MOD : /MOD UNDER ; % CHANGING NUMBER BASES: 'HEX : 72 RADIX-INDICATOR C! 16 RADIX W! ; 'DECIMAL : 88 RADIX-INDICATOR C! 10 RADIX W! ; 'OCTAL : 81 RADIX-INDICATOR C! 8 RADIX W! ; 'BINARY : 66 RADIX-INDICATOR C! 2 RADIX W! ; 'LTZ : 0 LT ; 'GTZ : 0 GT ; 'EQZ : NOT ; 'ABS : DUP LTZ IF MINUS THEN ; 'EQ : - NOT ; 'MIN : DDUP GT IF SWAP THEN DROP ; 'MAX : DDUP LT IF SWAP THEN DROP ; % RANGE TEST: '.. : 2OVER LT SWAP 2OVER GT LOR NOT UNDER ; % 'STACK : IFCR 40 TYO SP = 41 TYO % (STACKSIZE) SP SP 12 MIN 1- 0 DO 2 SPACES DUP S@ = 1- LOOP DROP ; % 'RSTACK : IFCR 'R( MSG RP 1- = 41 TYO % RSTACK SIZE RP 1- DUP 12 MIN 0 DO 2 SPACES DUP R@ = 1- LOOP DROP ; % RECURSE ALOWS ROUTINE OR COMPBUF TO CALL ITSELF 'RECURSE : 1 R@ W- % FIND ADDRESS OF WORD RECURSE IS IN 0 R@ W- % FIND WHERE RECURSE IS USED W! % "PATCH" R> W- NUMINSTRUCTIONS 'PNAME : DUP IF LAST-PRIMITIVE BEGIN DUP IF DDUP W@ EQ IF TELL TRUE ELSE NEXT-LINK FALSE THEN ELSE '(NO_NAME) MSG NOT THEN END DROP ELSE '; MSG DROP THEN ; % 'NAME : DUP KERNEL? IF PNAME ELSE TELL THEN ; % LLIST ADDRESS AND NAME: 'LNAME : DUP = 3 SPACES NAME CR ; % % LIST LAST TEN WORDS: 'NEXT10 : IFCR 10 0 DO DUP NOT IF ERR THEN DUP LNAME NEXT-LINK LOOP ; 'TOP10 : % OF VOCBULARY TO WHICH DEFINITIONS ARE % CURRENTLY BEING ADDED CURRENT W@ W@ NEXT10 ; 'VLIST : % TOP TEN WORDS IN FIRST VOCABULARY TO BE SEARCHED .V W@ W@ W@ NEXT10 ; % CASE INDICES: 'ICASE : 0 CASE@ ; 'JCASE : 2 CASE@ ; 'CASE-ADDR : 1 CASE@ ; '(ENDCASE) : IFCR "ENDCASE ENCOUNTERED WITH VALUE = " MSG ICASE = " AT " MSG CASE-ADDR = ERR ; '(ENDCASE) ADDRESS ENDCASE-PATCH W! % PATCH ENDCASE '(ENDCASE) ADDRESS FENCE W! % RAISE FENCE % SPECIAL STRING ROUTINES: % PACK puts TOS onto the end of the strings area. 'PACK : CURRENT-EOSTRINGS W@ C! CURRENT-EOSTRINGS 1+W! ; '=PACK : CURRENT-EOSTRINGS W@ BEGIN DUP -1 GT IF ASCII PACK REPEAT DROP R> CURRENT-EOSTRINGS W@ OVER - 1- OVER C! ; % =PACK IS USED TO CREATE A NUMBER STRING. IT % TAKES THE TOP SIGNED NUMBER ON STACK AND CONVERTS IT % TO A STRING THAT COULD BE OUTPUT BY MSG % THE NEXT TWO ROUTINES TAKE AS INPUT % A BUNCH OF STRING POINTERS % AND THEIR NUMBER FROM THE TOP OF STACK. 'MSGS-COUNT : SP 1- OVER LT IF "NOT ENOUGH STRINGS" MERR THEN 0 SWAP 1+ 1 DO I S@ C@ + LOOP ; 'MSGS : DUP 0 DO I' S@ MSG LOOP R> 0 DO DROP LOOP ; % In the above, MSGS will output a bunch of strings % that were left on stack IN THE ORDER they were placed % on stack, trying to place them all on the same line; % failing that, it will try and not split the individual % strings across lines. It will be used to improve the % DISASSEMBLER PACKAGE 'DIS-TRIAL : % CONTAINS ALL REL-OPS IN THE KERNEL DO +LOOP DO LOOP IF ELSE THEN OFCASE C: ;C ENDCASE : ; $: ;$ ; 'NEXT-TRIAL : % CONVENIENCE TO STEP THROUGH DIS-TRIAL W+ W+ DUP W@ ; 'OP-TYPE : % USED TO DEFINE WORDS FOR TESTING KERNEL OPS DUP : 3 EQ IF "" TRUE ELSE FALSE THEN ; CURRENT W@ W@ 6 W* + W! % GET THE NAME OF % DEFINITION ARGPATCH % RECORD THE VALUE OF OPCODE ; '3OVER FIND % IT STARTS WITH A LITERAL CONSTANT W@ 'LITERAL CONSTANT 'SHOWCODE FIND % IT STARTS WITH A STRING LITERAL W@ 'STRING-LIT CONSTANT 'TRANS FIND % IT IS A "$:" WORD W- W@ '[$:] OP-TYPE 'DIS-TRIAL FIND DUP W- W@ '[:] OP-TYPE NEXT-TRIAL '(+LOOP) OP-TYPE NEXT-TRIAL '(DO) OP-TYPE NEXT-TRIAL '(LOOP) OP-TYPE NEXT-TRIAL '(IF) OP-TYPE NEXT-TRIAL '(ELSE) OP-TYPE NEXT-TRIAL '(OFCASE) OP-TYPE NEXT-TRIAL '(C:) OP-TYPE W+ W+ NEXT-TRIAL '(:) OP-TYPE NEXT-TRIAL '(;) OP-TYPE W- NEXT-TRIAL '($:) OP-TYPE DROP 'REL-OP : SWAP W+ W@ =PACK " [" SWAP '] 4 MSGS W W+ ; 'DIS-TOKEN : DUP W@ OFCASE (;) C: MSG DROP W ;C LITERAL EQ C: W+ W@ =PACK MSG W W+ ;C STRING-LIT EQ C: W+ W@ '" SWAP OVER 3 MSGS W W+ ;C (DO) C: REL-OP ;C (LOOP) C: REL-OP ;C (+LOOP) C: REL-OP ;C (IF) C: REL-OP ;C (ELSE) C: REL-OP ;C (OFCASE) C: REL-OP ;C (C:) C: REL-OP ;C (:) C: REL-OP ;C ($:) C: REL-OP ;C TRUE C: NAME DROP W ;C ENDCASE ; 'WORD-ID : IFCR 39 TYO DUP MSG SPACE ADDRESS ; 'DIS : WORD-ID DUP W- DUP W@ DUP [:] IF MSG DROP ELSE [$:] IF MSG ELSE "NON-STANDARD IMMEDIATE WORD" MERR THEN THEN W- W- W- W@ % GET ^ TO END OF CODE SWAP DO TAB I DIS-TOKEN +LOOP TAB '; MSG ; % TRACE PACKAGE: % ROUTINE THAT DISPLAYS THE STATE OF THE MACHINE % AT EACH TRACE AND TERMINATES TRACE AT END OF % ROUTINE BEING TRACED. '(TRACE) : STACK 48 INDENT 0 R@ W@ DUP (;) IF MSG DROP 0 TRACE-LEVEL W! ELSE NAME 2 SPACES THEN ; % PERFORM PATCH: '(TRACE) ADDRESS TRACE-ADDR W! 'TRACE : WORD-ID "BEING TRACED:" MSG RP 3 + TRACE-LEVEL W! EXEC IFCR "TRACE COMPLETED" MSG CR ; % EDIT PACKAGE: -31 TRANS 'OUTFILE-STATUS CONSTANT -30 TRANS 'INPUTFILE-STATUS CONSTANT STRINGSMAX 200 - 'SAFE-END CONSTANT 1 'OLDLINE# VARIABLE EDITBUF 'OLDLINE^ VARIABLE EDITBUF 'EOT VARIABLE 'NEWF : 1 OLDLINE# W! EDITBUF OLDLINE^ W! 0 EDITBUF C! EDITBUF EOT W! ; NEWF % INITIALIZE EDITBUFFER 'NEXTLINE : DUP C@ DUP IF + 1+ ELSE "***NO SUCH LINE***" MERR THEN ; 'LISTALL : 1 EDITBUF BEGIN DUP C@ IF OVER = ": " MSG DUP MSG NEXTLINE SWAP 1+ SWAP REPEAT DROP DROP ; 'ILLEGLIN : "***ILLEGAL LINE #***" MERR ; 'LFIND : DUP OLDLINE# LT IF DUP 1 LT IF ILLEGLIN THEN DUP MAXLINNO GT IF ILLEGLIN THEN EDITBUF OVER 1 DO NEXTLINE LOOP ELSE DUP OLDLINE# % CALCULATE # OF - OLDLINE^ W@ % LINES NEEDED TO SWAP 0 DO NEXTLINE LOOP % ADVANCE THEN SWAP OLDLINE# W! DUP OLDLINE^ W! ; 'LDIR : % CHARACTER BLOCK MOVE, INCREASING % ON ENTRY: SOURCE, DESTINATION, # % ON EXIT: SOURCE+#, DESTINATION+# 0 DO OVER C@ OVER C! 1+ SWAP 1+ SWAP LOOP ; 'LDDR : % CHARACTER BLOCK MOVE, DECREASING % ON ENTRY: SOURCE, DESTINATION, # % ON EXIT: SOURCE-#, DESTINATION-# 0 DO OVER C@ OVER C! 1- SWAP 1- SWAP LOOP ; '#GETLINE : % TAKES THE LINE NUMBERED BY THE % TOP OF THE STACK AND TRANSFERS % IT INTO LINEBUF LFIND LINEBUF 1+ NEXTCH^ W! % SYSTEM ^S LINEBUF OVER C@ 1+ LDIR DROP DROP ECHO W@ IF LINEBUF MSG THEN % ECHO IF % APPROPRIATE ; '#GETLINE FIND #GET-ADDR W! % DO THE PATCH 'MTUP : % ON ENTRY: ^ TO BAS OF BLOCK BOUNDED BY EOT % ON EXIT: ^ TO BASE OF MOVED BLOCK AT STRINGSMAX EOT W@ 1+ SWAP - % # BYTES EOT W@ SWAP % SOURCE STRINGSMAX SWAP % DESTINATION LDDR UNDER 1+ ; 'OVERWRITE : % TAKES THE ^BOTTOM OF TEXT TO BE MOVED DOWN % ^TEXT TO BE OVERWRITTEN % AND ^LAST CHAR OF TEXT TO BE MOVED DOWN % ON EXIT LEAVES NO ARGS BUT HAS ADJUSTED EOT 1+ 2OVER - LDIR 1- EOT W! DROP ; 'MTDN : % ON ENTRY: ^ TO BASE OF BLOCK AT STRINGSMAX % AND ^ TO BASE OF DESTINATION STRINGSMAX OVERWRITE ; 'LENTER : % TAKES ADDRESS ON TOP OF STACK AND MOVES INPUT % LINE THERE; LEAVES A POINTER TO NEXT AVAILABLE % LOCATION. LINEBUF NEXTLINE LINEBUF DO I C@ OVER C! 1+ LOOP ; '1POSARG? : % TESTS STACK TO SEE IF THERE IS EXACTLY % ONE ARGUMENT; IT MUST BE POSITIVE. % ON EXIT IT LEAVES THAT ARGUEMENT. SP 1 EQ OVER -1 GT LAND NOT IF "NOT SINGLE, POSITIVE ARGUEMENT" MERR THEN ; 'ARG#ERR : "WRONG NUMBER OF ARGUMENTS" MERR ; 'LI : SP OFCASE EQZ C: LISTALL ;C 1 EQ C: LFIND MSG ;C 2 EQ C: DDUP GT IF OVER + 1- THEN 1+ SWAP DO I = ": " MSG I LFIND MSG LOOP ;C TRUE C: ARG#ERR ;C ENDCASE ; 'INPUT : 1POSARG? DUP LFIND MTUP SWAP DUP LFIND BEGIN SWAP DUP = ": " MSG 1+ SWAP GETLINE LINEBUF C@ 1 GT IF LENTER REPEAT UNDER MTDN ; '(DELETE) : LFIND DUP NEXTLINE SWAP EOT W@ OVERWRITE ; 'DELETE : 1POSARG? (DELETE) ; 'REPLACE : 1POSARG? DUP (DELETE) INPUT ; 'DELETES : SP 2 EQ IF DDUP LT IF OVER - 1+ THEN % IF ARG1