% ********************************************************* % * * % * PISTOL-Portably Implemented Stack Oriented Language * % * Version 2.0 * % * (C) 1983 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 * % * included. * % * * % ********************************************************* % BASIC DEFINITIONS FOR PISTOL 2.0 % % DECIMAL mode initially % +5 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 : +5 TRANS@ W@ W + W! ; % for 'CONSTANT 'VARIABLE, 'ARRAY 'CONSTANT : : 0 ; ARGPATCH ; 'LAST-PRIMITIVE CONSTANT -1 'TRUE CONSTANT 0 'FALSE CONSTANT -21 TRANS@ 'MININT CONSTANT -20 TRANS@ 'MAXLINNO CONSTANT -19 TRANS@ 'CHKLMT CONSTANT -18 TRANS@ 'RAMMIN CONSTANT -17 TRANS@ 'STRINGSMIN CONSTANT -16 TRANS@ 'STRINGSMAX CONSTANT -15 TRANS@ 'VBASE CONSTANT -14 TRANS@ 'VSIZE CONSTANT VBASE VSIZE W* + 'VMAX CONSTANT -13 TRANS@ 'CSIZE CONSTANT -12 TRANS@ 'LSIZE CONSTANT -11 TRANS@ 'RSIZE CONSTANT -10 TRANS@ 'SSIZE CONSTANT -9 TRANS@ 'LINEBUF CONSTANT LINEBUF 200 + 'EDITBUF CONSTANT -8 TRANS@ 'COMPBUF CONSTANT -7 TRANS@ 'RAMMAX CONSTANT -6 TRANS@ 'MAXORD CONSTANT -5 TRANS@ 'MAXINT CONSTANT -4 TRANS@ 'VERSION CONSTANT -3 TRANS@ 'NEWLINE CONSTANT -2 TRANS@ 'READ_PROTECT CONSTANT -1 TRANS@ 'WRITE_PROTECT CONSTANT 'ON : TRUE SWAP W! ; 'OFF : FALSE SWAP W! ; 'INFILE : +7 TRANS@ ; 'BYE : +31 TRANS ON ; +34 TRANS 'ABORT-PATCH CONSTANT +33 TRANS 'CONVERT-PATCH CONSTANT +32 TRANS 'PROMPT-PATCH CONSTANT +29 TRANS '(PISTOL<) CONSTANT +28 TRANS '.V CONSTANT +24 TRANS '#GET-ADDR CONSTANT % FOR PATCHING #GETLINE +23 TRANS 'TAB-SIZE CONSTANT +22 TRANS 'TRACE-ADDR CONSTANT +21 TRANS 'ENDCASE-PATCH CONSTANT +20 TRANS 'COLUMN CONSTANT +19 TRANS 'TERMINAL-WIDTH CONSTANT +18 TRANS '#LINES CONSTANT +17 TRANS 'TERMINAL-PAGE CONSTANT +16 TRANS 'COMPILE-END-PATCH CONSTANT +15 TRANS 'TRACE-LEVEL CONSTANT % USED AS BOOLEAN % AND LEVEL INDICATOR +13 TRANS 'RAISE CONSTANT +11 TRANS 'NEXTCH^ CONSTANT +10 TRANS 'CONSOLE CONSTANT +9 TRANS 'ECHO CONSTANT +8 TRANS 'LIST CONSTANT +6 TRANS 'PREVIOUS CONSTANT % UPDATED BY (V)FIND +5 TRANS 'CURRENT CONSTANT +4 TRANS 'OLD-EOSTRINGS CONSTANT % END OF PERMANENT % STRINGS VARIABLE +3 TRANS 'CURRENT-EOSTRINGS CONSTANT +2 TRANS '.D CONSTANT +1 TRANS '.C CONSTANT +0 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 : NEWLINE 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 : MININT SWAP 1- .. ; 'GT : 1+ MAXINT .. ; '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 ABS SWAP DUP LNOT 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 LNOT END DROP IFCR ; 'SHOWCODE : 0 COMPILE-END-PATCH W! ; 'CODESHOW FIND ARGPATCH '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 'ADDRESS : DUP FIND DUP IF UNDER ELSE IFCR 39 TYO DROP MSG " NOT FOUND" MERR THEN ; '/ : /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! ; % '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 IN WHICH WORD 0 R@ W- % FIND WHERE IS RECURSE 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 LNOT THEN END DROP ELSE '; MSG DROP THEN ; % 'NAME : DUP PRIMITIVE? IF PNAME ELSE TELL THEN ; % VOCABULARY MAINTENANCE PACKAGE: % LLIST ADDRESS AND NAME: 'LNAME : DUP = 3 SPACES NAME CR ; % LIST LAST TEN WORDS: 'NEXT10 : IFCR 10 0 DO DUP LNOT 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 ; 0 'ITEM VARIABLE 'FIND_PREVIOUS,NEXT : % GIVEN THREAD, FINDS ENTRY MOST % RECENT AFTER ITEM AND THE ONE % JUST BEFORE IT % EXIT: PREV(LATER CHRON),NEXT BEGIN DUP NEXT-LINK DUP ITEM W@ GT IF UNDER REPEAT ; % IMPROVED FORGET DEVELOPED AUG 8, 1982 0 'FENCE VARIABLE 'VFORGET : % TOS IS A VOCABULARY TO BE CUT BACK % TO BEFORE "ITEM" DUP W@ DUP ITEM W@ GT IF FIND_PREVIOUS,NEXT UNDER W<- ELSE DROP DROP THEN ; 'FORGET : ADDRESS DUP ITEM W! % SIMPLIFIES LOGIC! FENCE W@ GT IF VBASE .V W! % RESET VSTACK (PISTOL<) CURRENT W! BRANCH-LIST W@ BEGIN ITEM W@ OVER LT IF W+ W@ REPEAT DUP BRANCH-LIST W! BEGIN % TRIM EACH VOCAB DUP VFORGET W+ W@ DUP IF REPEAT DROP ITEM W@ DUP W- W- W@ DUP OLD-EOSTRINGS W! CURRENT-EOSTRINGS W! 3W- DUP W@ CURRENT W@ W! W- .D W! ELSE "BELOW FENCE" MERR THEN ; 'FORGET FIND FENCE W! % SET FENCE 'VADDRESS : % TAKES NAME,VOCAB ON STACK; GETS ITS ADDRESS % RETURNS IT ON TOP OF STACK IF IN VOCAB OVER SWAP VFIND DUP IF UNDER ELSE 39 TYO DROP MSG " NOT IN VOCABULARY" MERR THEN ; 'REMOVE : % TAKE NAME,VOCAB ON STACK ;GET ITS ADDRESS % (SAVED IN ITEM); PUT PREVIOUS-> NEXT DDUP VADDRESS DUP ITEM W! DUP 2OVER W@ - % NOT LAST DEFINED? IF NEXT-LINK PREVIOUS W@ 3W- % PREV->NEXT ELSE NEXT-LINK OVER % VOCAB->NEXT THEN W! DROP DROP ; 'ADD_LINK : % GIVEN VOCABULARY, LINK IN ITEM IN % PROPER CHRONOLOGICAL ORDER DUP W@ ITEM W@ LT IF DUP W@ ITEM W@ 3W- W! % UPDATE VOCAB ITEM W@ W<- % INSTALL LINK TO % OLD HEAD ELSE W@ FIND_PREVIOUS,NEXT ITEM W@ 3W- W! % ADJUST LINK OF ITEM 3W- ITEM W@ W<- % LINK PREVIOUS THEN ; 'UNLINK : % TAKES STRING ON TOS AND UNLINKS IT FROM % SEARCH PATH AND LINKS IT INTO THE % UNLINKED< VOCABULARY BRANCH CURRENT W@ REMOVE (UNLINKED<) ADD_LINK ; 'RELINK : % TAKES NAME ON TOS AND REMOVES IT FROM THE % UNLINKED< VOCABULARY; LINKS IT INTO THE % CURRENT VOCABULARY (UNLINKED<) REMOVE CURRENT W@ ADD_LINK ; 'DEFINITIONS : % SETS CURRENT TO TOP VOCABULARY IN IN VSTACK .V W@ W@ CURRENT W! ; 'LAST-PRIMITIVE UNLINK 'W, UNLINK 'ALLOT UNLINK 'CODESHOW UNLINK 'VFORGET UNLINK 'REMOVE UNLINK 'ITEM UNLINK 'LNAME UNLINK 'FIND_PREVIOUS,NEXT UNLINK 'ADD_LINK UNLINK ' BEGIN DUP 0 GE 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 ; 'ENDCASE-PATCH UNLINK 'MSGS-COUNT UNLINK 'LINE-SPACE? UNLINK % 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 'Z : 'Z ; 'Z 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 NEXT-LINK % GET ^ TO END OF CODE SWAP DO TAB I DIS-TOKEN +LOOP TAB '; MSG ; 'Z UNLINK 'CASE-ADDR UNLINK '(ENDCASE) UNLINK 'PACK UNLINK 'LITERAL UNLINK 'STRING-LIT UNLINK '[:] UNLINK 'DIS-TRIAL UNLINK 'NEXT-TRIAL UNLINK 'OP-TYPE UNLINK '[$:] UNLINK '(+LOOP) UNLINK '(DO) UNLINK '(LOOP) UNLINK '(IF) UNLINK '(ELSE) UNLINK '(OFCASE) UNLINK '(C:) UNLINK '(:) UNLINK '($:) UNLINK 'REL-OP UNLINK 'DIS-TOKEN UNLINK % 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 ; '(;) UNLINK 'WORD-ID UNLINK '(TRACE) UNLINK % EDIT PACKAGE: +27 TRANS 'OUTFILE-STATUS CONSTANT +26 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 MAXLINNO .. LNOT 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@ IF % NOT NULL LINE? OVER C@ 1+ LDIR ELSE 1 OVER C! 1+ NEWLINE OVER C! THEN DROP DROP % ECHO IF APPROPRIATE: ECHO W@ IF LINEBUF MSG THEN ; '#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 % 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 LNOT 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 U.C. DUP 97 122 .. IF 32 - ELSE THEN ; 'COL#? : % RETURNS THE # OF ':' AT START OF LINE 0 LINEBUF 1+ BEGIN DUP C@ :' EQ IF 1+ SWAP 1+ SWAP REPEAT DROP ; 'TYIL : % READ FIRST CHAR FROM KEYBOARD; EXHAUST REST OF LINE TYI DUP NEWLINE - IF BEGIN TYI NEWLINE EQ END THEN ; 'MENU : % ON ENTRY NOTHING % ON EXIT: # OF LINES-1 (IF NO MENU, RETURN -1) -1 BEGIN GETLINE COL#? LNOT IF 1+ DUP IF DUP 1- A' + TYO )' TYO TAB THEN LINEBUF MSG REPEAT ; 'TEXT : % PRINTS LINES UNTIL A LINE STARTING WITH A ":" % NO STACK ACTIVITY BEGIN GETLINE COL#? LNOT IF LINEBUF 1+ LINEBUF C@ TYPE REPEAT ; 'LOCATE : % INPUT: SELECTION #, DELIM # % OUTPUT: NONE SWAP 1- 0 DO BEGIN GETLINE COL#? OVER EQ END LOOP DROP ; 'SELECTION : % INPUT: HIGHEST ACCEPTABLE % OUTPUT: POSITIVE # OF SELECTION 0 BEGIN DROP "ENTER LETTER OF SELECTION(Q TO ABORT):" MSG 0 #LINES W! % RESET LINE COUNT 0 COLUMN W! % RESET COL COUNT TYIL UC DUP Q' EQ IF ABORT THEN A' - 1+ DUP 1 3OVER .. END UNDER ; '(HELP) : LIST OFF BEGIN MENU DUP GTZ % DOES MENU EXIST? IF SELECTION COL#? LOCATE REPEAT DROP TEXT ; 'HELP : % WILL PROVIDE THE USER WITH AN ONLINE FACILITY TO % LOOK UP THINGS SP LNOT IF 'PISTOL.HLP THEN % SUPPLY DEFAULT NAME IF % NONE IS PROVIDED LOAD (HELP) CR "HELP COMPLETED" MSG 0 +7 TRANS W! % RETURN CONSOLE INPUT ; ':' UNLINK ')' UNLINK 'COL#? UNLINK 'MENU UNLINK 'TEXT UNLINK 'LOCATE UNLINK 'SELECTION UNLINK '(HELP) UNLINK ;F