The FORTH/Assembler ROM is a powerful addition to the HP71 portable computer. The Assembler, unfortunately, contained five (5) known errors. Shortly after the ROMs release (Dec. 1984) HP made available a FORTH screen (TEXT File) which could be LOADFed to fix two (2) of the bugs. Since HP had been kind enough to provide the hooks into the assembler, I decided to take things one step further, and fix the other three bugs. At the same time, I decided to enhance the listing headers and the Symbol Table. While not perfect, I have used this version extensively since March 1986 with no trouble. The five known bugs of the FORTH/Assembler ROM are as follows... [1] B=B+B A opcode has a bad "class". The effect is to cause the assembler to assign an improper length to the opcode during pass 1. Subsequently, during pass 2, all labels following the B=B+B A instruction, are bad. Needless to say, the asssembled code won't work! [2] D1=AS has a bad opcode. When you attempt to assemble a D1=AS instruction, what you will actually get is a D0=AS opcode. [3] When assembling FORTH primitives, and if, for some reason, the assembly must be done a second time, the system can issue a "not unique" error message. When compiling FORTH secondaries, this error does not occur because the smudge bit is set. With primitives however, the smudge bit is not used. The fix is to clear the old name from memory before reassembly. [4] The next bug is that when assembling a LEX file containing 10 (dec) or more BASIC keywords, and using the FORTH/Assembler pseudo-ops, the FORTH system must be set to DECIMAL mode. If HEX mode is set upon invoking the assembler, the labels for the TEXT Table entries are constructed improperly, resulting in a bad assembly. [5] The last bug is more of an annoyance as opposed to a problem. If the Symbol table is large, and overflows past one page, the labels reported after page one have their values given in decimal as opposed to hex. Since the assembler only outputs five digits, and a five digit hex number given in decimal needs seven (FFFFF=1048575) leading digits are dropped. After reviewing the above bugs, I decided to try to fix them. The following code is my implementation of the fix. The file is called "FIX5A" because it fixes 5 bugs and is revision A. To fully understand what is occuring, you will need a copy of the FORTH/Assembler IDS which is available through CHHU. You will also need at least a simple understanding of FORTH. In a few complex places, I have included stack use diagrams to help follow flow. In order to fix bugs deep inside the code, it required rewriting routines from the top level down. As a result, among other changes, I decided to call the invoking word "SASM". By not calling this "ASSEMBLE" the user may still invoke the HP version at will. Some of my names match those headerless words in the ROM, others do not. After examining the following code and reviewing the FORTH IDS, the user may wish to customise the file. The only potential bugs in this file I know of are as follows... (1) If an assembly error occurs as the last line of a listing file, the title reported on the next page comes from the ROM version as opposed to my version. This is only a cosmetic flaw and I chose to live with it. The reason is that to eliminate it would require rewriting ALL calls to the error driver which are SO many, that it simply was far more rewrite than I felt necessary. (2) My routine in word "EJLINE" which pushes page numbers to the far right gets mildly sick if the Subtitle variable is its maximum length. This pushes the last digit of the page number into oblivion. Being the lazy person I am, I have not bothered to fix it! (quite easy to do really) Since the assembler has been stripped apart this far, it should be trivially easy to add new features. The only caution I have is to be sure to watch stack use carefully. As the bulk of my party (conference) talk is going to be assembly questions and answers, this ends my "formal" writeup. John R Baker [618] ( Ver<860307>, John R Baker ) ( if the version changes... ) ( be sure to update it in word EJLINE ) ( This code fixes 5 bugs in the FORTH/Assembler ROM ) ( [1] B=B+B A which has bad class ) ( [2] D1=AS which has bad opcode ) ( [3] 'not unique' errors for primitives ) ( [4] decimal mode needed for assembly ) ( [5] hex mode during Symbol table listing ) ( It also enhances the assembly statistics listing somewhat ) ( it rewrites the code to output listing lines ) ( it also redefines EJECT and STITLE, of necessity ) ( EJECT is class 40d, 28h ) ( STITLE is class 41d, 29h ) ( both, have flag 1 set so no pass 1 processing is needed ) ( to work, EJECT needs only call EJLINE ) ( STITLE extracts and stores text, done in NEWSTITLE ) ( ****************************************************************************) ( This first section sets up ) ( It defines four new opcode tables: B=B+B, D1=AS, EJECT, and STITLE ) HEX CREATE NEWB 42502 , B423D , 20422 , 5304 , 1000 , CREATE NEWD 44505 , 13D31 , 20534 , 39305 , 1 , CREATE NEWEJE 45528 , 3454A , 20544 , 1 , 0 , CREATE NEWSTIT 53629 , 44954 , 454C5 , 1 , 0 , ( ****************************************************************************) : OUTLIN [ EF600 , ] ( check ON ) [ E9B69 , ] @ LISTING SWAP DROP [ E348B , ] IF ( now listing ? ) [ E9B1E , ] @ ?DUP IF ( pil ? ) PRIMARY ! OUTPUT CRLF OUTPUT ELSE ( output pil ) [ EAC68 , ] THEN ( else print file ) 1 [ E9AEC , ] +! ( increment line # ) NULL$ THEN 2DROP [ EA3B0 , ] ; ( clear stack & line var ) ( ****************************************************************************) : EJLINE [ E9B69 , ] @ IF 0 [ E9AEC , ] ! 1 [ E9B50 , ] +! ( reset line#, increment page# ) C CHR$ OUTLIN ( send form feed ) " FORTH Saturn Assembler, " [ E9B05 , ] S! [ E9B05 , ] [ E9A56 , ] S<& ( add title ) DUP 48 SWAP DO 20 CHR$ S<& LOOP ( push page # to far right of page ) " Page: " S<& [ E9B50 , ] @ DECIMAL [ EA450 , ] ( read page # ) S<& OUTLIN " Rev.<860307>, JR Baker, " [ E9B05 , ] S! [ E9B05 , ] [ E9A6F , ] S<& ( add STITLE ) DUP 48 SWAP DO 20 CHR$ S<& LOOP ( add spaces ) " DATE$" BASIC$ S<& ( add date after subtitle ) OUTLIN ( send line ) NULL$ OUTLIN THEN ; ( send one blank line ) ( ****************************************************************************) : OUT.LINE OUTLIN ( send the line ) [ E9AEC , ] @ PAGESIZE @ > IF ( have lines exceeded pagesize ? ) EJLINE THEN ; ( yes, eject ) ( ****************************************************************************) : OUT.LIST LISTING SWAP DROP [ E9B69 , ] @ [ E348B , ] ( is listing on & specified ) IF [ E9C4A , ] @ 18 MIN 7 + 8 / 1 MAX 0 ( only 8 nibs per line ) DO [ EA3B0 , ] [ E9B05 , ] [ E0A40 , ] 0= ( clear list line variable ) IF DECIMAL [ E9A88 , ] @ 1- [ EA46E , ] ELSE ( generate line number ) [ EA329 , ] THEN ( unless multi-line needed ) S<& HEX [ E998E , ] @ [ E0A40 , ] 8 * + ( generate location counter ) [ E9A0B , ] @ 1 > IF ( check if LEX or BIN ) [ E9EA2 , ] @ - THEN ( if so make it relative ) [ EA48C , ] S<& [ E0A40 , ] ( add to line ) 8 * DUP 8 + SWAP ( setup loop for 8 opcode nibs ) DO [ E0A40 , ] [ E9C4A , ] @ 1- > IF ( end of this opcode yet ? ) [ EA360 , ] ELSE ( yes, generate blanks ) [ E0A40 , ] 11 > IF 0 ELSE ( get opcode nibble ) [ E0A40 , ] 1+ [ EA4C3 , ] @ THEN ( this handles BSS opcodes ) [ EA41E , ] THEN S<& LOOP ( add nibble to opcode string ) [ E0A40 , ] 0= IF ( is this first line ? ) [ EA347 , ] S<& [ E9ABA , ] ( yes, append source to listing line ) 4B MIN S<& THEN OUT.LINE ( send the line ) LOOP THEN DECIMAL ; ( ****************************************************************************) : SPIT [ E99A7 , ] @ IF ( check test match ) [ EC6A0 , ] 0= [ E9C4A , ] @ [ E348B , ] IF ( only if line generates code ) 15 [ EB082 , ] THEN THEN ( report error ) [ EAAE4 , ] ( output object code ) OUT.LIST ; ( output listing ) ( ****************************************************************************) : DO.LINE [ EF600 , ] [ EF6DF , ] [ EF2CF , ] ( check ON, disp ., parse source ) [ E9C18 , ] @ 16 = 0= IF ( check label field, except EQUs ) [ EF972 , ] THEN ( process labels ) [ EC9F0 , ] IF ( pass 1 ? ) [ EC678 , ] 0= IF ( is flag 1 set ? ) [ EF837 , ] THEN ( no, determine length ) [ E9A0B , ] @ 0= IF ( is filetype declared ? ) 33 [ EA70A , ] THEN ELSE ( no, error out ) [ EF837 , ] ( pass 2 process routine ) SPIT THEN ( send to object & listing ) [ EF931 , ] FFFF7 [ EA3EC , ] ( update location count, line errors ) [ E99C0 , ] ! ; ( ****************************************************************************) : DO.PASS [ EFAD5 , ] ( initialise pas ) BEGIN [ EA98F , ] [ E99F2 , ] @ 0= AND ( read source until EOF ) WHILE DO.LINE ( process line ) REPEAT ; ( ****************************************************************************) : NEWSTITLE [ ED9F1 , ] [ E9A6F , ] S! EJLINE ; ( new STITLE handler ) ( ****************************************************************************) ( This outputs the Symbol table to the Listing device ) : OUTSYT " ------>> Assembler Symbol Table <<------" [ E9A6F , ] S! ( store in subtitle variable ) EJLINE ( eject ) [ EA3B0 , ] ( clear listing line ) " Text Decimal Hex Type" OUT.LINE " ------ ------- ----- -------------" OUT.LINE [ E9E0C , ] @ HEX ( get address of symbol table ) BEGIN ( while there are symbol table entries ) DUP @ -1 = 0= WHILE DUP 6 ( extract label ) [ E9B05 , ] 2SWAP S<& [ EA347 , ] S<& ( append to listing line ) ROT C + DUP @ OVER ( extract value ) 5+ N@ 1 AND [ E9A0B , ] @ 1 > AND IF ( check if label & not FORTH ) [ E9EA2 , ] @ - THEN ( not FORTH, get relative value ) DUP >R DECIMAL 0 <# [ EA405 , ] # # # # # # # #> ROT >R S<& R> R> HEX ( this is actual bug fix... ) ( can also be changed in EJLINE ) [ EA48C , ] ROT >R S<& R> ( append value to listing line ) 5+ DUP N@ DUP 0= ( read symbol type ) IF DROP " Pass 1 EQUate" ELSE 2 = IF " Pass 2 EQUate" ELSE " Label" THEN THEN ( --- addr cnt addr' addr" cnt" ) ROT >R ( --- addr cnt addr" cnt" ) 2SWAP [ EA347 , ] S<& ( add two spaces after value ) 2SWAP S<& R> ( add type of symbol --- addr cnt addr' ) ROT ROT OUT.LINE ( output the line ) 1+ REPEAT ( get next entry & repeat --- addr ) ( ----------------------------------------------------------------------------) DROP ( blow off address pointer, we're done ) " ------->> Assembler Statistics <<-------" [ E9A6F , ] S! DECIMAL 6 0 DO ( send six blank lines ) NULL$ OUT.LINE LOOP " **********************>> Assembler Parameters <<**********************" OUT.LINE NULL$ OUT.LINE NULL$ OUT.LINE [ E9B05 , ] " Source File is : " S<& [ E9AA1 , ] S<& OUT.LINE NULL$ OUT.LINE " Object File is : " [ E9B05 , ] S! [ E9B05 , ] [ E9B82 , ] DUP 0= IF ( send object file name ) 2DROP " FORTHRAM" THEN ( unless it is FORTHRAM ) S<& OUT.LINE ( send line ) NULL$ OUT.LINE " Object File Size: " [ E9B05 , ] S! [ E9B05 , ] [ E9EBB , ] @ ( read object file size ) [ EA48C , ] S<& " nibbles" S<& OUT.LINE NULL$ OUT.LINE " Object File Type: " [ E9B05 , ] S! [ E9B05 , ] [ E9A0B , ] @ DUP 1 = IF DROP " FORTH" ELSE DUP 2 = IF DROP " LEX" ELSE 3 = IF " BIN" ELSE " ?????" THEN THEN THEN S<& OUT.LINE NULL$ OUT.LINE [ E9B05 , ] " Listing File is : " S<& LISTING S<& OUT.LINE NULL$ OUT.LINE " Total Symbols : " [ E9B05 , ] S! [ E9B05 , ] [ E9E25 , ] @ 1- ( read number of symbols ) [ EA450 , ] S<& OUT.LINE ( format & send line ) NULL$ OUT.LINE " Assembly Date : " [ E9B05 , ] S! [ E9B05 , ] " DATE$" BASIC$ S<& ( setup date ) OUT.LINE ( send line ) NULL$ OUT.LINE " Assembly Time : " [ E9B05 , ] S! ( setup time ) [ E9B05 , ] " TIME$" BASIC$ S<& OUT.LINE ( send time ) NULL$ OUT.LINE " Assembly Errors : " [ E9B05 , ] S! [ E9B05 , ] [ E9A3D , ] @ DUP 0= IF DROP " None" ELSE [ EA450 , ] THEN S<& OUT.LINE ( send errors ) NULL$ OUT.LINE " **********************>> end of assembly <<***************************" OUT.LINE NULL$ OUT.LINE ( subtract 1 from line count, do form feed ) -1 [ E9AEC , ] +! C CHR$ OUT.LINE ; ( ****************************************************************************) ( The following code is called if its' address is in 2FC79 ) ( It checks for mnemonics and returns false flag if not ours ) ( If ours, returns opcode table address and true flag ) : NEWCODE 2DUP " B=B+B" S= IF 2DROP NEWB -1 ELSE 2DUP " D1=AS" S= IF 2DROP NEWD -1 ELSE 2DUP " EJECT" S= IF 2DROP NEWEJE -1 ELSE " STITLE" S= IF NEWSTIT -1 ELSE 0 THEN THEN THEN THEN ; ( ****************************************************************************) ( this is the new process routine code ) ( with flag 1 set, it only answers pass 2 ) : NEWPROC DUP 28 = IF DROP EJLINE ELSE 29 = IF NEWSTITLE THEN THEN ; ( ****************************************************************************) ( This defines SASM as the word to invoke the assembler ) ( It fixes the DECIMAL mode, WORD Not Unique, & Symbol table bugs ) ( it also fixes two defective ROM opcodes ) : SASM ( clear dictionary from HERE to PAD ) HERE PAD OVER - 0 NFILL ( check for a valid string at the PAD ) ( tests if string end is past stack start ) PAD 2+ DUP C@ 2* + 2+ SP@ 2DUP < ( now clear to top of data stack ) IF OVER - 0 NFILL ELSE 2DROP THEN ['] NEWCODE 2FC79 ! ( invoke new opcode handler ) ['] NEWPROC 2FC7E ! ( invoke new process routine ) [ E45B1 , ] @ ( ensure FORTHX not executing ) IF 3F [ E9ED4 , ] CR TYPE CR ABORT THEN BASE @ [ E1B1A , ] ! DECIMAL ( save current base value ) [ EFC6C , ] ( initiialise variables ) 1 [ E997A , ] ! DO.PASS ( do pass 1 ) " FiLeNd" [ EB517 , ] ( see if user screwed-up and used FiLeNd ) IF 3D [ EA70A , ] THEN ( if so, shutdown; that's a no-no... ) [ E998E , ] @ DUP " FiLeNd" [ EB6A7 , ] ( else add FiLeNd to Symbol table ) [ E9EA2 , ] @ - [ E9EBB , ] ! ( compute & store filesize in nibs ) [ EA976 , ] ( reset source file to start ) 2 [ E997A , ] ! DO.PASS ( now do pass 2 ) [ E9B69 , ] @ IF OUTSYT THEN ( output Symbol table if listing given ) [ EA663 , ] ( purge Symbol table & close files ) 0 2FC7E ! 0 2FC79 ! ; ( reset new opcode flag ) DECIMAL