LEX 'MAPLEX' HP71 character set converter * * Tapani Tarvainen 86/09/07 * * Function MAP$ maps given set of characters onto another * in a string; statement MAP does the same for * an entire TEXT (LIF1) file. * * Syntax: MAP$(,,) * MAP ,, * where , and are string expressions * and is a file specifier (literal or string expr). * * The file must reside in RAM and it mustn't be secured; * the strings and must be of equal length. * If some char occurs several times in , * it's the first one that counts. * * For example, MAP$("calculator","ac","xz") returns * "zxlzulxtor", and * MAP F$,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ" * will convert entire file F$ to upper case. * * Errors: * Invalid Filespec, File Not Found as appropriate; * Invalid File Type if non-TEXT file; * Illegal Access if not in RAM; * Protected if SECUREd; * Invalid Arg if LEN()#LEN(); * Insufficient Memory results if there isn't enough * room for the conversion table (256 bytes, see below); * End of File means the file is bad (record length points * beyond end of file). * * Algorithm: Create a 256-byte table, where Nth byte * is the new value for char N, and replace every char * in the file with corresponding element in the table. * ************************************************ ID #5E MSG 0 POLL POLLH ************************************************ * Mainframe entry points ARGERR EQU #0BF19 Invalid Arg CHKmem EQU #012C7 check avail memory w/o leeway COMCK EQU #036CD comma check COMCK+ EQU #032AE check comma & output comma token DROPDC EQU #05470 decompile opt expr list EXPEX- EQU #0F178 collapse mathstack, evaluate expr EXPR EQU #0F23C function return FILDC* EQU #05759 decompile filespec FILXQ^ EQU #09B76 Filename Execute FINDF+ EQU #09F63 find file, w/checks FSPECe EQU #02F02 parse error: Invalid File Spec FSPECp EQU #03CC5 parse filespec GETPR1 EQU #06BFB check file protection MFERR EQU #09393 mainframe error NTOKEN EQU #0493B get next token (parse) NXTSTM EQU #08A48 re-enter BASIC interpreter POP1S EQU #0BD38 pop string from math stack RAMROM EQU #0A5F7 classify device RESPTR EQU #03172 restore input pt (in parse) STRNGP EQU #0379D parse mandatory string expr SYNTXe EQU #02E2B parse error: Syntax * Other symbols * Error numbers eEOFIL EQU #36 End of File eFFACS EQU #3C Illegal Access eFSPEC EQU #3A Invalid File Spec eFTYPE EQU #3F Invalid File Type eFnFND EQU #39 File Not Found * System RAM addresses STMTR0 EQU #2F871 statement scratch STMTR1 EQU #2F881 statement scratch * local symbols sMAP$ EQU 3 flag to distinguish MAP$ and MAP ************************************************ ENTRY MAP$ CHAR #F function ENTRY MAP CHAR #D legal everywhere KEY 'MAP$' TOKEN 5 KEY 'MAP' TOKEN 6 ENDTXT ************************************************ * Poll handler for VER$ POLLH ?B=0 B pVER$? GOYES VER$ RTNSXM VER$ C=R3 stk pt D1=C D1=D1- (Ve)-(Vs)-2 str length CD1EX A=R2 AVMEMS ?C output tCOMMA GONC syntx no, syntax error GOSBVL STRNGP str1 GOSBVL COMCK comma? (not tokenized) GONC syntx no, syntax error GOSBVL STRNGP str2 GOVLNG RESPTR return to parser * parse errors badf GOVLNG FSPECe "Invalid Filespec" syntx GOVLNG SYNTXe "Syntax" ************************************************ * MAP$ function start NIBHEX 44433 3 string params MAP$ ST=1 sMAP$ indicates were in MAP$, not MAP CD0EX save D0 (program counter) R0=C in R0 GOTO bldtbl go build conversion table ************************************************ * MAP statement run-time code start REL(5) dMAP offset to decompile routine REL(5) pMAP offset to parse routine MAP GOSBVL FILXQ^ evaluate filespec GOC fspOK filespec OK LC(2) eFSPEC "Invalid Filespec" GONC mferr BET * We save FILXQ^ result (file name & port info) in * statement scratch during EXPEXC. Note that we can't * call FINDF first, as EXPEXC might change the file * address, or SECURE or PURGE it (or CREATE!) fspOK D1=(5) STMTR0 save FILXQ^ result (A & D) DAT1=A W file name D1=(2) STMTR1 port info * STMTR0 and STMTR1 have same 3 high order digits C=D W DAT1=C W D0=D0+ 2 step over comma GOSBVL EXPEX- strings to mathstack CD1EX FINDF+ &c use D1 but not D0, D0=C so we save stack pt in D0 D1=(5) STMTR0 recover FILXQ^ result A=DAT1 W D1=(2) STMTR1 C=DAT1 W D=C W GOSBVL FINDF+ find the file GOC mferr not found, error GOSBVL RAMROM in RAM? GOC ram ok LC(2) eFFACS "Illegal Access" GONC mferr BET ram GOSBVL GETPR1 check protection ?SB=0 secure? GOYES noprot no, go ahead GONC mferr "Protected" (B.E.T.) noprot A=0 A A=DAT1 4 file type A=A-1 A ?A=0 A TEXT? GOYES textf LC(2) eFTYPE "Invalid File Type" mferr GOVLNG MFERR * Now we know it's unprotected text file in RAM: let's go! textf CD0EX mathstack pt CD1EX back to D1, R0=C file addr to R0 ST=0 sMAP$ indicates were in MAP, not MAP$ * clearing sMAP$ earlier isn't a good idea: * some sub we call (EXPEXC!) might change it ************************************************ * MAP$ function and MAP statement join here * the strings are in mathstack: get addresses bldtbl GOSBVL POP1S pop str2 CD1EX D0=C str2 addr to D0 B=A A str2 length A=A+C A skip past str2 D1=A point at str1 header GOSBVL POP1S pop str1 ?A=B A equal lengths? GOYES strsOK GOVLNG ARGERR no, Invalid Arg strsOK ACEX A str2 addr to A (for CHKmem) D=0 M we'd only need to clear nib 5 D=C A length in nibs DSRB in bytes (used as counter) CD1EX B=C A str1 addr to B(A) * The conversion table will be located at AVMEMS * First we check there is room for it (256 bytes) LC(5) 512 # of nibs needed GOSBVL CHKmem memory check GOC mferr Insufficient Memory D1=A available memory start * Initialize the table to map each char to itself C=0 B start with CHR$(0) init DAT1=C B write char to table D1=D1+ 2 next table element C=C+1 B next char GONC init * Initialization could be done faster as follows: * LCHEX 0101010101010101 assumes P=0 * A=C W * LCHEX 0706050403020100 * init DAT1=C W * D1=D1+ 16 * C=C+A W * GONC init * * This would cost 37 nibs and save ca 7000 cycles * Then we change the table so that if Ith char in * str1 is N, Nth entry is set to Ith char of str2 ABEX A table start to B(A) AD1EX str1 addr to D1 * ready to set up the conversion table: * D1=str1 addr, D0=str2 addr, B(A)=table addr, D(A)=str length D=D-1 A adjust counter GOC nop in case str1 & str2 null strings setup A=0 A A=DAT1 B str1 char A=A+A X double to get nibble offset A=A+B A add table start AD1EX C=DAT0 B corresp. str2 char DAT1=C B put in table AD1EX str1 adr back to D1 D1=D1+ 2 next char D0=D0+ 2 in both strings D=D-1 A decrement counter GONC setup * table is ready, its addr in B(A) nop ?ST=0 sMAP$ in MAP statement? GOYES stmt ************************************************ * set things up for converting str0 (in mathstack) CD1EX str0 header addr; it is where D1=C D1 (stack pt) must be on exit RSTK=C we save it in RSTK A=0 M need to clear nib 5 D1=D1+ 2 skip type tag (0F or 8F) A=DAT1 A str0 length (nibs) ASRB convert to bytes D1=D1+ 14 skip rest of str0 header GOTO iconv join MAP ************************************************ * Initialize conversion of file stmt A=R0 recover file addr D1=A D1=D1+ 16 link field addr A=DAT1 A link field contents D1=D1+ 5 beginning of data * we need the end-of-file address to check * if a line length header points beyond it * (which means the file is corrupted, but * even that should't cause total disaster) CD1EX D1=C C=A+C A end of file D=C A save in D(A) * File conversion loop * D1 = next record length field addr * B(A) = conversion table addr * D(A) = end-of-file addr (used as a safeguard) * P=0 nxtrec A=0 XS A=DAT1 B 1st byte of rec length D1=D1+ 2 ASL A move left ASL A A=DAT1 B 2nd byte - now in proper order D1=D1+ 2 LC(5) #FFFF end-of-file marker ?A=C A GOYES done eof, we're done A=A+1 A must add 1 if odd LCHEX E P=0 A=A&C P clear lsb CD1EX next check for corrupt file D1=C C=C+A A C=C+A A add rec len twice (it's bytes!) ?C>D A past eof? GOYES Eof error ************************************************ * Here MAP and MAP$ join again * D1 points to first char of record/str0 * A(A)= # of chars to convert (str/rec length) * B(A)= conversion table addr iconv A=A-1 A adjust counter GOC nullst null string or zero-length record * innermost loop: this is where the time is spent conv C=0 A C=DAT1 B read char C=C+C X double to get nibble offset C=C+B A add table start D0=C * it might be possible to set things up so * that D0=CS could be used above, and all * A fields replaced with WP (with P=3) or X, * but I don't think it's worth the trouble C=DAT0 B read corresp. char in table DAT1=C B write back D1=D1+ 2 skip to next char A=A-1 A GONC conv nullst ?ST=0 sMAP$ MAP statement? GOYES nxtrec yes, next record ************************************************ * MAP$ done: restore pointers & return to EXPR C=RSTK recover D1 (mathstack pt) D1=C C=R0 and D0 (program counter) D0=C GOVLNG EXPR return * Successfull termination of MAP statement done GOVLNG NXTSTM * End of File -error (corrupted file) Eof LC(2) eEOFIL GOTO mferr END