LEX 'TSORTLX9' * COPYRIGHT BY MICHAEL MARKOV 1988 ID 91 MSG 0 POLL 0 ENTRY APPEND CHAR #D ENTRY BCOPY CHAR #D ENTRY BDEL CHAR #D ENTRY BMOVE CHAR #D ENTRY BREV CHAR #D ENTRY LASTR CHAR #F ENTRY PTINSe CHAR #D ENTRY RCOPY CHAR #D ENTRY RMAXSZ CHAR #F ENTRY RMOVE CHAR #D ENTRY RSWAP CHAR #D ENTRY TXTMAC CHAR #F ENTRY TXTMAX CHAR #F ENTRY TXTMIC CHAR #F ENTRY TXTMIN CHAR #F KEY 'APPEND' TOKEN 91 KEY 'BCOPY' TOKEN 92 KEY 'BDEL' TOKEN 93 KEY 'BMOVE' TOKEN 94 KEY 'BREV' TOKEN 95 KEY 'LASTR' TOKEN 96 KEY 'PTINSERT' TOKEN 97 KEY 'RCOPY' TOKEN 98 KEY 'RMAXSZ' TOKEN 99 KEY 'RMOVE' TOKEN 100 KEY 'RSWAP' TOKEN 101 KEY 'TXTMAXC' TOKEN 102 KEY 'TXTMAX' TOKEN 103 KEY 'TXTMINC' TOKEN 104 KEY 'TXTMIN' TOKEN 105 ENDTXT ********************** * See file TSORTDOC for syntax and other documentation ********************************** REL(5) RMOVEd Offset to RMOVE decompile routine REL(5) RMOVEp Offset to RMOVE parse routine BREV GOSUB mgo process channel # and evaluate parameters GOSUB GetPr1 pop the parameters and save them in R1,R3 GONC BREV10 GOTO NXTSTM to GOVLNG #08A48 =NXTSTM exit since = BREV10 ?C>A A GOYES BREV11 R3=A R1=C BREV11 GOSUB FIB find the desired text file. See FIB above. GOSUB From? Save start of record 0 in R0, start of in R3 GOSUB NXTRC check to see if end of file GONC BREVOK and error-out unless exists GOTO ARGERR save start of next record in R2 BREVOK CD0EX now, save the PC (you must!) RSTK=C on the stack C=R1 and reverse R0=C Save start of block GOSUB FindTo GONC Found8 C=R3 D1=C GOSUB NXTRC Found8 R3=C D=C A the absolute end of block revrec C=R1 D1=C GOSUB NXTRC GOC BREVbl CR1EX save start of next record, get old A=R1 GOSUB REV GOTO revrec BREVbl C=R0 A=R3 GOTO MOVEex CURPOS D1=(5) #2F896 C=DAT1 A FIB ADDRESS D1=C D1=D1+ 16 D1=D1+ 5 @ FILE DATA START A=DAT1 A C=R0 NEW CURRENT POS C=C-A A NEW OFFSET D1=D1+ 16 D1=D1+ 3 DAT1=C A UPDATE CURPOS RTN RMOVEd LCHEX 23 '#' RMOVE/RSWAP decompile routine GOSBVL #02CE8 =OUTBYT GOVLNG #05493 =FIXDC numck GOVLNG #0369D =NUMCK BMOVEp GOSBVL #03356 =#CK BMOVE Parse routine GOC eSYNT D1=D1+ 2 GOSUB numck to GOVLNG #0369D =NUMCK GOSBVL #032AE =COMCK+ GOSUB numck to GOVLNG #0369D =NUMCK LCHEX F1 =tCOMMA ?C#A B GOYES eSYNT GONC BMOVE+ RMOVEp GOSBVL #03356 =#CK RMOVE/RSWAP parse routine GOC eSYNT D1=D1+ 2 GOSUB numck to GOVLNG #0369D =NUMCK GOSBVL #032AE =COMCK+ BMOVE+ GOSUB numck to GOVLNG #0369D =NUMCK LCHEX F1 =tCOMMA ?C#A B GOYES eSYNT GOSUB numck to GOVLNG #0369D =NUMCK GOVLNG #03172 =RESPTR eSYNT ST=1 4 SYNTXe GOVLNG #02E2B APPp GOSBVL #3356 =#CK GOC eSYNT D1=D1+ 2 skip over '#' token GOSBVL #0369D =NUMCK, check channel # LCHEX F2 =tSEMIC ?C#A B GOYES SYNTXe GOSBVL #02CEB =OUT1TK GOVLNG #0379D =STRNGp, or =PUTp ************************************ * REV Entry: * C[A] = start address of a record or set of records to be reversed * A[A] = start of record that follows the record(s) to be reversed * may be end of file address * Exit: A[A], C[A], B[W], D0, D1 are all used. Original contents are * not saved. If carry is set, nothing was done because the block length * was zero. A subsequent ?C>A A /GOYES error would show invalid inputs. * * Here, we must keep in mind that text file records are all an even number * of bytes long. The minimum length is 2 bytes for a '0000' header **************************************** REV ?C>=A A test for errors and zero-length block RTNYES Nothing to do, or error. D0=C low addr D1=A high addr. A=A-C A block length (nibs) B=0 W pre-clear for BSRB B=A A our loop counter BSRB # of bytes to swap BSRB # pairs of bytes in block BSRB # of exchanges required B=B-1 A less 1, for carry RTNC if carry, there were 0 exchanges required ***************************** * Since we reached this far, the block length was at least 4 nibbles, * with lengths of 4, 8, 12, ... nibbles possible. So, consider that * originally, B was at least 0100 (Binary). The first BSRB changed * B to 0010, the second to 0001, the last to 0000. Then, B=B-1 sets * carry and we exit with RTNC. If the length is was 8, or 1000 binary, * the number of exchanges is 1, which is no surprise. But what happens * if the length is a multiple of 3? Consider the length of 12 nibs: * B=1100 => 0110 => 0011 => 0001. Again, only one exchange is required, * because the 'odd' byte pair in the center is our pivot, and does not * have to be moved. * Exchanging pairs of bytes is roughly 30% faster than exchanging bytes. * Exchanging entire registers would be considerably faster, but would * require a lot more code to insure the exchanges work properly. ****************************** RVloop D1=D1- 4 exchange upper pair of bytes with lower pair A=DAT0 4 adjusting the pointers C=DAT1 4 DAT1=A 4 DAT0=C 4 D0=D0+ 4 B=B-1 A until our counter says we are done GONC RVloop RTNCC ******************************* * FIB and FIB3 are utilities that locate the file using the channel * number saved in CHN#SV or in A[B], respectively. When done, D1 * points to the start of record 0. Uses A,B,C,P,D1,R0. * * On exit, FIB entry address is saved in STMTD1, D[A] = End Of File * D1 = start of record 0 header. * * FIB and FIB3 error-out with eInvalid File Type if the file is not * an unsecured text file, or with eInvalid Access if the file is not * in either main RAM or in IRAM. ******************************* FIB D1=(5) #2F96F RAM=CHN#SV (stored there by GETCH#) A=DAT1 B FIB3 GOSBVL #11457 =FIBADR D1=D1+ 5 @ file type in FIB A=0 A A=DAT1 4 P= 0 C=0 A LCHEX 1 unsecured TEXT files only ?C=A A is the file type correct? GOYES FtypOK LCHEX 3F No, eInvalid File Type BSERR GOVLNG #0939A =BSERR FtypOK D1=D1+ 7 @ Device type in FIB C=DAT1 S C=C-1 S GOC DEVcOK (MAIN RAM=0) C=C-1 S GOC DEVcOK (IRAM=2) LCHEX 3C eIllegal Access - sorry, that's all we handle GONC BSERR DEVcOK D1=D1+ 1 @ File Header Start in FIB A=DAT1 A D1=A @ start of file header D1=D1+ 16 D1=D1+ 16 @ offset to next file in file header C=DAT1 A AD1EX C=C+A A End of file D=C A End of file in D[A] D1=A D1=D1+ 5 @ start of record 0 RTN ************************************** * NXTRC is the routine that computes the address of the next record in * the file. * * Entry: D1= @ start of previous record * D[A] = @ start of next file, as computed from file header * * Exit: if carry clear, then * C[A] = address of next record * A[A] = length of current record in nibbles * D1 = @ start of current record +2 * else, if carry, then * C[A] = end of file. This may be the result of either A) coming to an * EOF marker, when the record header is FFFF hex, or B) coming * to the point where C[A] = D[A] . Both situations are * legitimate, although including an EOF marker provides a * degree of additional safety. * In the (hopefully rare) event that C[A] > D[A], we do not return to * the code that called NXTRC. Instead, we exit with an eEnd of File error. * This error tells us that the file structure of the text file has been * corrupted, and that you should hurry to back-up all your files before * crash time arrives. *************************************** NXTRC CD1EX D1=C ?D<=C A is D1 at or beyond EOF? GOYES EOF A=0 A get length of record. A=DAT1 B the most significant byte ASL A move it to A[3,2] ASL A D1=D1+ 2 the least significant byte A=DAT1 B in A[1,0] P= 3 test for FFFF end of file marker A=A+1 WP GOC EndFil Not RTNC, since you must reset P to zero P= 0 * if the header gave an odd length, A=A+1 A above rounded the length up * and bit 0 is 0. If not, bit 0 is now 1. Thus, A=A+1 A and ASRB below * round-up the length of header and make allowance for any pad bytes ASRB A=A+1 A makes allowance for the 4 nibs of the header A=A+A A A=A+A A in nibbles, as required for the HP-71 C=C+A A start of next record (C[A] was start of record) RTNCC EOF ?C=D A is EOF valid? GOYES EndFil SysErr P= 0 No, issue the eEOF error. LCHEX 0036 GOTO BSERR EndFil P= 0 RTNSC ******************************************** * GetPr1 is a subroutine to read the parameters of the RMOVE and * RSWAP statments ********************************************* GetPr1 GOSBVL #136CB =RNDAHX R3=A save in R3 D1=D1+ 16 GOSBVL #136CB =RNDAHX R1=A save in R1 GOSBVL #091FB =COLLAP collapse math stack A=R1 C=R3 ?C=A A if equal, there is nothing to do, exit RTNYES gracefully with carry set RTNCC ************************************************ * FindTo returns the address of the record in R3[A]. * Since may be any number for RMOVE when you want to move material to the * end of file (like using PRINT#N,99999;A$), we cannot error-out automatically * like the From? routine above. * * Entry: R3[A] holds the desired record number * B[A] holds the current record number * C[A] holds the address of the start of the current record. * This assumes desired record number > current record. * If in doubt, use B=0 W, and C[A] = start of file data from FIB * * Exit: if carry is set, then the desired record exists and its address is * in R3[A]. Else, you are at a legal EOF, and the address is in C[A]. This * acommodates repeated use of FindTo by both BMOVE and RMOVE. **************************************************** FindTo D1=C D1 @ start of record 0, or at start of CR3EX if less than ?B=C A B[A] is the current record#, R(3) is what we want RTNYES found. We are done. CR3EX no, restore R3 for next go around B=B+1 A increment the record counter GOSUB NXTRC find the next record (address in C[A]) GONC FindTo keep trying until found RTNCC unless EOF is reached, which we signal by clearing carry ****************************************************** * From? is essentially identical to FindTo above, except that R1 holds the * desired record number, and that must exist, or we * error-out. ****************************************************** From? CD1EX D1 @ start of record 0. R0=C save in R0 for FindTo B=0 W clear our record counter FndFrm D1=C same as FindTo above CR1EX ?B=C A RTNYES CR1EX B=B+1 A GOSUB NXTRC GONC FndFrm ARGERR GOVLNG #0BF19 =ARGERR ( must exist) * * mgo is the routine used by TSORTLEX to process the channel # and other * statment parameters. CAUTION: the combination of MGOSUB and GETCH# uses +5 * stack levels. Avoid calling mgo from subroutines! * mgosub GOVLNG #1AF01 =MGOSUB the typical processing of statment mgo GOSUB mgosub that may move around in memory as you insert/ delete CON(5) #11427 =GETCH# parameters. See DATALEX source D0=D0+ 2 GOSUB mgosub CON(5) #0F178 =EXPEX- GOSBVL #1954E =D1MSTK (D1 not valid after MGOSUB) RTN ********************************************************* * This ends the primary utilities that are called again and again ********************************************************* REL(5) RMOVEd Offset to RMOVE decompile routine REL(5) BMOVEp Offset to BMOVE parse routine BMOVE GOSUB mgo process channel # and evaluate parameters GOSBVL #136CB =RNDAHX D1=D1+ 16 R2=A Save parameter GOSUB GetPr1 pop the & parameters and save them in R1,R3 A=R1 C=R3 ?C MUST be equal to or greater than GOYES ARGERR C=R2 ?C<=A A may not be inside block GOYES DESTOK A=R3 ?C in R3 GOSUB NXTRC check to see if end of file GOC ARGERR and error-out unless exists C=R0 B=0 W GOSUB FindTo GONC BMeof GOSUB NXTRC BMeof CR2EX CR3EX GOTO Bmov+ ARgerr GOTO ARGERR **************************** REL(5) RMOVEd Offset to RMOVE decompile routine REL(5) RMOVEp Offset to RMOVE parse routine RMOVE GOSUB mgo process channel# and evaluate parameters GOSUB GetPr1 pop the parameters and save them in R1,R3 GONC RMOV10 NXTSTM GOVLNG #08A48 =NXTSTM exit since = RMOV10 GOSUB FIB find the desired text file. See FIB above. GOSUB From? Save start of record 0 in R0, start of in R3 GOSUB NXTRC check to see if end of file GOC ARgerr and error-out unless exists R2=C save start of next record in R2 Bmov+ C=R0 get start of record 0, since may be less than B=0 W . Clear record counter GOSUB FindTo and find GOC Found2 not EOF, R3 is start of R3=C save the address of start. ********************************************* * At this point, we have all the addresses we need: * C[A] = start of * R3 = start of * R2 = end of * R1 = start of ********************************************** Found2 CD0EX now, save the PC (you must!) RSTK=C on the stack C=R1 and reverse A=R2 GOSUB REV A=R1 start of C=R3 start of ?C>A A and, depending on whether moves up or down, GOYES MOVEup reverse to or GOSUB REV reverse to start of A=R2 set-up for CURPOS,and reverse block C=R1 A=A-C A C=R3 A=A+C A R0=A A=R2 and, finally, the entire block ************************************** * MOVEex is the common exit for RMOVE, BMOVE and RSWAP. * R0[A] holds the address of the record to which the current file position * pointer will be set. The sole exception is RSWAP where the record lengths * are identical, in which case the pointer is left unchanged. ************************************* MOVEex GOSUB REV GOSUB CURPOS adjust pointer to current line MOVex1 C=RSTK restore PC D0=C GOSBVL #1954E =D1MSTK GOTO NXTSTM MOVEup C=R2 reverse from end of to start of A=R3 GOSUB REV C=R1 reverse entire block, start of to start of A=R3 R0=A set-up for CURPOS (current file position adjust) GOTO MOVEex ********************************** REL(5) RMOVEd Offset to RSWAP decompile routine REL(5) RMOVEp Offset to RSWAP parse routine RSWAP GOSUB mgo process channel # and evaluate parameters GOSUB GetPr1 pop parms which have been evaluated, and save GONC RSWP10 if #, keep processing GOTO NXTSTM else we do not have to do anything. ************************************************** * SWAPEQ is a very fast routine for exchanging two records of equal lengths. * On entry, A[A] = length of records, in nibbles, including headers * R1 = start of , at header * R3 = start of , at header * it is assumed that D0 and D1 have been preserved, as needed * The location of SWAPEQ was selected to be within range of GOC SWAPEQ, * while allowing the GOC MOVex1 without an intermediary GOTO. * NOTE: the record headers MUST be exchanged, since records with odd number of * characters have a pad byte. Otherwise, the pad byte could become visible * while the last character in the other record could be hidden. ****************************************** SWAPEQ B=A A B[W] was cleared by From?. Only B[A] has been used. BSRB convert length to # of bytes BSRB convert to pairs of bytes C=R3 get start of D0=C A=R1 get start of D1=A SwpEq1 B=B-1 A anything to swap? GOC MOVex1 No, we are done A=DAT0 4 exchange a pair of bytes C=DAT1 4 DAT1=A 4 DAT0=C 4 D0=D0+ 4 advance to pair of bytes to be moved D1=D1+ 4 GONC SwpEq1 B.E.T. ***************************************************** RSWP10 ?C>A A In a swap, and are interchangeable. GOYES RSWP11 to simplify code, we define < R3=A exchange and if required R1=C RSWP11 GOSUB FIB find the file. D1 @ start record 0 GOSUB From? find , save in R1. GOSUB NXTRC get length (in nibs, in A[A]) GOC Argerr sorry, must exist. We only found EOF. B=B+1 A increment pointer for FindTo R0=A save length of R2=C save end of GOSUB FindTo R3= start of GONC Argerr must exist for a swap GOSUB NXTRC get length of GOC Argerr OOPS! that was EOF, does not exist CR0EX save end of , get length of ********************************************* * At this point, we have all the addresses we need: * C[A] = end of * R3 = start of * R2 = end of * R1 = start of * R0 = end of ********************************************** CD0EX save PC on stack RSTK=C CD0EX restore length of ?C=A A are and of equal length? GOYES SWAPEQ for a much faster execution time C=R1 reverse A=R2 GOSUB REV C=R3 reverse A=R0 GOSUB REV C=R2 reverse any stuff between and A=R3 GOSUB REV C=R1 now, reverse entire block A=R0 GOTO MOVEex now, exit using common code Argerr GOTO ARGERR **************************** * pop is a utility commonly used for sequentially poping function * numerical parameters. See the SEARCH keyword, IDS vol.I **************************** pop GOSBVL #136CB =RNDAHX * GOSBVL #1B223 =FLTDH D1=D1+ 16 RTN A[A] holds the result, in hex, ready for next parm ************************************** * popchn pops the chanel # for LASTR and MAXRSZ, and saves D1 ready for * putting the results of these functions on the stack. Errors-out if an * invalid channel number is given (Max is 255) ******************************************* popchn GOSUB pop D1=D1- 16 * P= 0 LCHEX FF max channel # ?C >=EOF ****************************** * MiMax is the routine that processes the parameters of the TXTMIN/TXTMAX * functions, making sure that the specified parameters are valid ****************************** MIMAX GOSUB pop pop the channel # C=0 A LCHEX FF ?C record number R3=A save GOSUB pop get C=R3 compare it with ?C>A A is less than ? GOYES ToGtFr fine, keep processing R3=A else, exchange and CAEX A (we could also invoke argerr) ToGtFr R1=A save GOSUB pop get col. C=0 A LCHEX FFFE max allowable record length ?C C=0 A LCHEX F we handle up to 16 bytes A=A-1 A ?C>=A A GOYES stofld A=C A stofld ASRC shift #bytes to A[S] C=R2 read back into C C=A S R2=C save and <#bytes> in R2 ******************************************************* * At this point, * R0 = channel # * R1 = * R2[S] = <# bytes> * R2[A] = * R3 = ********************************************************* D1=D1- 16 for outputing results CD1EX save D0 D1=(5) #2F8C0 =FUNCD1 DAT1=C A save D0 D1=D1- 5 CD0EX save D0 in =FUNCD0 DAT1=C A D0=C keep PC valid in case is not found A=R0 get the channel # GOSUB FIB3 D[A]=EOF D1@ record 0 GOSUB From? find C=R1 R0=C GOSUB NXTRC GONC TSTLEN return if not EOF (begin line MUST exist) ARGerr GOTO argerr else, error-out TSTLEN C=R2 get the start column ST=1 0 ?A be EOF * B[9-5] = record * R3 = * R1 = * if we find a new record less than , it becomes * the process continues until or EOF is found. ***************************** NEXTR GOSUB NEXT Get last record start (we know it exists) GOC TminEx GOSUB NXTRC GOC TminEx GOSUB SETPTR GOC BA=MIN NXTBYT A=DAT0 B C=DAT1 B ?C A B GOYES NEXTR A=A-1 S GOC NEXTR D0=D0+ 2 D1=D1+ 2 GONC NXTBYT B.E.T. TminEx BSRC 1 Shift min. rec into B[A] BSRC 2 BSRC 3 BSRC 4 BSRC 5 BA=MIN D0=(5) #2F8BB A=DAT0 A D0=D0+ 5 C=DAT0 A D1=C AD0EX ABEX A GOSBVL #1B31B =HDFLT DAT1=A W GOVLNG #0F23C =EXPR NIBHEX 88888855 5 Mandatory parameters TXTMIC GOSUB MIMAX GOC BA=MIN NewMic GOSUB New ************************************** * B[4-0]= record we compare to * B[9-5] = record, also NewMin * R3 = * R1 = * if we find a new record less than , it becomes * the process continues until or EOF is found. ***************************** NEXTRC GOSUB NEXT advance to next record GOC TminEx GOSUB NXTRC GOC TminEx GOSUB SETPTR GOC BA=MIN CONVUC EQU #152AA ********************************* * P must be 0. However, the previous GOSUB NXTRC takes care * of this for us ************************** NXTBYC GOSUB GETUC ?C A B GOYES NEXTRC A=A-1 S GOC NEXTRC D0=D0+ 2 D1=D1+ 2 GONC NXTBYC B.E.T. **************************************************** NewMaX ST=0 0 new will be long enough GOTO NewMax NIBHEX 88888855 5 Mandatory parameters TXTMAX GOSUB MIMAX NewMax GOSUB New ************************************** * B[4-0]= record we compare to be EOF * B[9-5] = record, and the current maximum * R3 = * R1 = * if we find a new record greater than , it becomes * the process continues until or EOF is found. ***************************** NEXTR2 GOSUB NEXT Get last record start (we know it exists) GOC TmaxEx has been reached GOSUB NXTRC D1 @ new record to compare GOC TmaxEx we have reached end of file GOSUB SETPTR set the test pointers GOC NEXTR2 sorry, too short to be a new max, skip it. ?ST=1 0 invalid ? GOYES NewMaX yes, do not compare, this must be a NewMax NXTBY2 A=DAT0 B OK, lets do some testing C=DAT1 B ?C A B GOYES NewMax A=A-1 S GOC NEXTR2 D0=D0+ 2 D1=D1+ 2 GONC NXTBY2 B.E.T. ********************** TmaxEx GOTO TminEx ***************************** NewMaC ST=0 0 we now have a valid , clear flag GOTO NewMac NIBHEX 88888855 5 Mandatory parameters TXTMAC GOSUB MIMAX NewMac GOSUB New ************************************** * B[4-0]= record we compare to be EOF * B[9-5] = record, and the current maximum * R3 = * R1 = * if we find a new record greater than , it becomes * the process continues until or EOF is found. ***************************** NEXTR4 GOSUB NEXT Get last record start (we know it exists) GOC TmaxEx has been reached GOSUB NXTRC D1 @ new record to compare GOC TmaxEx we have reached end of file GOSUB SETPTR set the test pointers GOC NEXTR4 sorry, too short to be a new max, skip it. ?ST=1 0 invalid ? (too short for comparisons) GOYES NewMaC NXTBY4 GOSUB GETUC OK, lets do some testing, converting to uppercase ?C A B GOYES NewMac A=A-1 S GOC NEXTR4 D0=D0+ 2 D1=D1+ 2 GONC NXTBY4 B.E.T. ************************ * NEXT is a convenient subroutine used by our TXTMIN/TXTMAX * functions. The purpose is to advance to the next record to be * tested. * Exit: if carry is set, then the search is finished * if carry is clear, keep processing ************************* NEXT C=R0 Get last record start (we know it exists) D1=C GOSUB NXTRC R0=C D1=C B=B+1 A CR3EX ?C and , GOSBVL =CONVUC converting both to uppercase if applicable C=A B using ST for temporary storage. ST=C A=DAT0 B GOSBVL =CONVUC C=ST ST=0 0 since we are comparing, is long enough. **************************** * the alternative is to use the stack for temp. storage. **************************** RTN ************************************** * The code for APPEND comes straight from EDLEX, see IDS vol. I, 17-20+ * the major difference is the removal of code having to do with * REPLACE#, DELETE# and status flag tests associated with that stuff. * Finally, code is removed since we do not have a record # to process ********************** **************************** REL(5) RMOVEd REL(5) APPp APPEND GOSBVL #01435 =OBCOLL GOSUB mgo process channel # and evaluate string parm GOSUB ins$ CD1EX C=start of record#0 (header) posEOF D1=C GOSUB NXTRC GONC posEOF * We are now at EOF, with C[A] = EOF address. NXTRC does not return if bad file flOK A=C A Start of next line C=0 A flOK+ R3=C (length of previous line, 0 since we insert.) D1=(5) #2F896 =STMTD1, where FIBADR saved the FIB address C=DAT1 A D1=C D1=D1+ 13 C=DAT1 A C[A]=file header address GOSUB mgosub =MGOSUB CON(5) #013F7 =RPLLIN GONC APPok GOTO BSERR error # in C[A] APPok C=A A save address of end of inserted material+1 (new RSTK=C address - where we set the file pointer) D1=(5) #2F96F =CHN#SV A=0 A A=DAT1 B GOSBVL #11457 =FIBADR D1=D1+ 16 D1=D1+ 5 A=DAT1 A C=RSTK C=C-A A D1=D1+ 16 D1=D1+ 3 DAT1=C A D1=D1+ 6 C=DAT1 A A=R3 A=A+C A DAT1=A A GOSBVL #01435 =OBCOLL GOVLNG #08A48 =NXTSTM ***************************************** REL(5) RMOVEd Offset to RMOVE decompile routine REL(5) RMOVEp Offset to RMOVE parse routine BDEL GOSBVL #01435 =OBCOLL GOSUB mgo process channel # and evaluate parameters GOSUB GetPr1 pop the parameters and save them in R1,R3 ?C in R3 GOSUB NXTRC check to see if end of file GOC ARGER and error-out unless exists C=R1 get start of record 0, since may be less than GOSUB FindTo and find GOC Found6 we found it, and it exists. R3=C save start of in R3[A] GONC BD B.E.T. Found6 GOSUB NXTRC calculate the length of BD R0=C save end of . Note that if EOF,C[A] remains at EOF ********************************************* * At this point, we have all the addresses we need: * C[A] = end of * R3 = start of * R2 = end of * R1 = start of * R0 = end of ********************************************** C=R1 A=R0 C=A-C A GOTO flOK+ C=start of line, A=start of next line/file ARGER GOTO ARGERR ********************************************************* REL(5) RMOVEd Offset to RMOVE decompile routine REL(5) BMOVEp Offset to BMOVE parse routine BCOPY GOSUB mgo process channel #, eval. parameters GOSBVL #136CB =RNDAHX D1=D1+ 16 R2=A Save parameter GOSUB GetPr1 pop the & parameters and save them in R1,R3 A=R1 C=R3 ?C MUST be equal to or greater than GOYES ARGER GOSUB FIB GOSUB From? Save start of record 0 in R0, start of in R3 GOSUB NXTRC check to see if end of file GOC ARGER and error-out unless exists C=R0 B=0 W GOSUB FindTo GONC BCeof EOF is in C[A] GOSUB NXTRC not EOF, get record end in C[A] BCeof CR2EX in either case, save it in R2, and get the CR3EX parameter, and put in into R3 so we can find it. GOTO BCop+ go to common code in RCOPY **************************** REL(5) RMOVEd Offset to RMOVE decompile routine REL(5) RMOVEp Offset to RMOVE parse routine RCOPY GOSUB mgo process channel #, eval. parameters GOSUB GetPr1 pop the parameters and save them in R1,R3 GOSUB FIB find the desired text file. See FIB above. GOSUB From? Save start of record 0 in R0, start of in R3 GOSUB NXTRC check to see if end of file GOC ARGE and error-out unless exists, cannot copy R2=C save start of next record in R2 BCop+ C=R0 get start of record 0, since may be less than B=0 W . Clear record counter GOSUB FindTo and find GOC Found7 not EOF, R3 is start of R3=C save the address of start. ********************************************* * At this point, we have all the addresses we need: * C[A] = start of * R3 = start of * R2 = end of * R1 = start of ********************************************** Found7 GOSBVL #01435 =OBCOLL collapse AVMEMS to OUTBS A=R1 end of block C=R2 start of block C=C-A A length of block ************************************** * Here, we want to move the block to be inserted into the ouput buffer so that * we can insert it in front of with RPLLIN. We must make sure * the available memory is adequate. ************************ P= 0 GOSBVL #012A5 =MEMCKL GONC MEMOK B[A] is now the block length, D1=AVMEMS GOTO BSERR eMEM was loaded for us by MEMCKL MEMOK C=A A set C[A] = AVMEMS, from MEMCKL C=C+B A update AVMEMS D1=(5) #2F594 DAT1=C A C=A A D1=C A=R1 source start GOSBVL #01308 =MOVE*M - all entry conditions are preserved. C=R3 GOTO flOK Insert the stuff with APPEND common code ARGE GOTO ARGERR ***************************************** ins$ GOSBVL #0BD31 =REVPOP line to be appended is now on the stack B=0 W B= # bytes B=A A BSRB CD1EX C = string start D1=(5) #2F599 =AVMEME A=A+C A DAT1=A A D0=C D0 @ SOURCE START D0=D0- 4 A=B A write line header GOSBVL #17A24 =SWPBYT DAT0=A 4 B=B+1 A round-up, records are even bytes long BSRB B=B+1 A Add two bytes for header ******************************** * NIBHEX C5 is used instead of the B=B+B A instruction because of a * bug in the HP-71 FORTH/ASSEMBLER ROM (bad class) that causes assembler * errors such as "duplicate label" to crop-up. Other problem instructions * include D1=AS (bad opcode, should be 139) and CON(6). NIBHEX C5 or B=B+B A and convert to nibs NIBHEX C5 B=B+B A B[A]= block length D1=D1- 5 update AVMEMS A=DAT1 A A=A+B A DAT1=A A A=A-B A D1=A set D1 to DEST start GOSBVL #1B162 =MOVEU0 ************************** * Here, we omit some code to copy the target line# to R1, where * the line in the output buffer is to be inserted *************************** GOSUBL FIB RTN **************************** REL(5) RMOVEd REL(5) APPp PTINSe GOSBVL #01435 =OBCOLL GOSUB mgo process channel #, eval parm. GOSUB ins$ D1=(5) #2F896 we want to insert at file pointer. Where is it? C=DAT1 A so, get it from FIB, whose address is saved in STMTD1 D1=C D1=D1+ 16 D1=D1+ 5 A=DAT1 A D1=D1+ 16 D1=D1+ 3 C=DAT1 A C=C+A A here it is! ?C>D A above file? GOYES eBADPT sorry, system screwed-up ?C