ASMB,A,B,L * * Overlay for BASIC 20392 * Original 11/29/10 Last mod 12/4/10 * This version is for older smaller-mem machines - it does not have * the HP-IPL/OS exit functions (calls 1 and 2), can be inserted before * or after BASIC drivers depending on edited configuration. Includes * a binary save function that punches memory to an ABS file. * * CALL(3,address,data) POKE - put data into address * CALL(4,address,var) PEEK - put data from address into var * CALL(5,address) EXEC - execute subroutine at address and return * CALL(6,address) JUMP - execute code at address, don't return * CALL(7,var) GETCH - set var to next byte from console * CALL(8,byte) PUTCH - send byte to console * * Installation... (for listed configuration) * Load 8KW BASIC configured with no PTR/PTP drivers (TTY only) * Load assembled overlay (patches run/BYE, removes MAT instructions) * Run from location 100, enter BYE to halt at binary saver * If punch isn't slot 13, put punch slot in location 16553 (DFLPU) * Attach PTP to output binary, continue/run to punch binary * At next halt detach PTP, continue/run to re-enter BASIC * ORG 121B DEF LINKS DEF LKEND * if inserting the following 4 code lines must be enabled * if adding after the drivers then comment the next 4 lines ORG 106B DEF BEGIN-1 ORG 116B OCT 0 * uncomment next 5 code lines to remove matrix instructions * comment next 5 lines to enable matrix instructions ORG 110B OCT 11456 ORG 4110B OCT 0 OCT 0 * patch run address to autorun, patch BYE to run saver ORG 2 JMP 3,I OCT 5137 ORG 76B DEF BEGIN JMP 76B,I * set below to location of overlay - must not conflict * for 8KW BASIC with no PTR/PTP must end before 17217 * for other configs determine carefully ORG 16550B BEGIN JMP SVBIN jump to binary saver STADR OCT 2 address to save from * set below to last mem location to save to ABS ENADR OCT 17677 address to save to * set below to punch channel DFLPU OCT 13 * * link table... LINKS OCT 1003 call 3 two parms DEF POKE poke memory OCT 1004 call 4 two parms DEF PEEK peek memory OCT 405 call 5 one parm DEF EXEC execute subroutine OCT 406 call 6 one parm DEF JUMP jump to code OCT 407 call 7 one parm DEF GETCH get char from console OCT 410 call 8 one parm DEF PUTCH send char to console LKEND EQU * * * Float/Fixed subs... in orig version these were 21MX instructions * For this version converted to call BASIC subs to run on older machines * * Convert 16 bit int in A to FP in A/B DOFLT NOP * OCT 105120 21MX FLT instruction JSB 246B,I call basic's FLOAT code, direct equivalent? JMP DOFLT,I * * Convert FP in A/B to 16 bit int in A * signed, FP must be -32768 to 32767 * if out of range then return 077777 (like 21MX FP) DOFIX NOP * OCT 105100 21MX FIX instruction * basic has no direct replacement but has IFIX but it behaves differently * returns to return+1 (skips) with B=int, A=something related to high bits * but for this use if not 0 or 177777 then B isn't valid. If out of range * (for whatever this code does) then doesn't skip return. So... JSB 247B,I call basic's IFIX code LDB FERRV didn't skip on return so error SZA,RSS skip if A<>0 JMP DOFI2 A=0 so OK INA,SZA skip if A=177777 LDB FERRV not 177777 either so error DOFI2 LDA 1 put B in A JMP DOFIX,I FERRV OCT 77777 * * parm temps PAR1A OCT 0 address PAR1B OCT 0 float 1 PAR1C OCT 0 float 2 PAR1I OCT 0 int value PAR2A OCT 0 PAR2B OCT 0 PAR2C OCT 0 PAR2I OCT 0 M1 DEC -1 for decrementing * * parm subs GET2P NOP LDB 0,I get address of first parm STB PAR1A save address ADA M1 dec ptr LDB 0,I get address of second parm STB PAR2A save JSB PTRAN fetch FP values and convert to int JMP GET2P,I GET1P NOP LDB 0,I get address of first parm STB PAR1A save address JSB PTRAN JMP GET1P,I PTRAN NOP LDA PAR1A get address of parm 1 LDB 0,I get 1st FP word STB PAR1B save INA point to next FP word LDB 0,I get 2nd FP word STB PAR1C save LDA PAR2A same for parm 2 (even if not used) LDB 0,I STB PAR2B INA LDB 0,I STB PAR2C * convert parms to int LDA PAR1B get parm 1 fp 1 LDB PAR1C get parm 1 fp 2 JSB DOFIX convert to fixed STA PAR1I save in parm 1 int LDA PAR2B same for parm 2 LDB PAR2C JSB DOFIX STA PAR2I JMP PTRAN,I * * update parm 1 with int in A * overwrites PARM1B/C PARM1I not affected UPDP1 NOP JSB DOFLT convert to float STA PAR1B save fp 1 STB PAR1C save fp 2 LDB PAR1A get parm address LDA PAR1B get fp 1 STA 1,I save to parm var INB bump pointer LDA PAR1C get fp 2 STA 1,I save to parm var+1 JMP UPDP1,I * * update parm 2 with int in A * overwrites PARM2B/C PARM2I not affected UPDP2 NOP JSB DOFLT STA PAR2B STB PAR2C LDB PAR2A LDA PAR2B STA 1,I INB LDA PAR2C STA 1,I JMP UPDP2,I * * put 2nd parm into address spec'd by 1st parm POKE NOP JSB GET2P get 2 parms convert to int LDA PAR2I get data STA PAR1I,I store in address JMP POKE,I * * put data from address spec'd by 1st parm and put into 2nd parm PEEK NOP JSB GET2P LDA PAR1I,I get memory data JSB UPDP2 update 2nd parm JMP PEEK,I * * execute subroutine at address spec'd by parm EXEC NOP JSB GET1P JSB PAR1I,I JMP EXEC,I * * jump to address spec'd by parm (no return) JUMP NOP JSB GET1P JMP PAR1I,I * * Direct access non-interrupt console drivers * These bypass the normal TTY driver, slot is fetched from * the driver which is assumed to be a Rev A or Rev B version * (no patch occurs if it is not). * * The BASIC TTY driver config is a bit hard to parse... the * prepare program (and even the driver itself) rewrites the code. * The self-patch code here patches only if it finds the right * instruction, otherwise goes with what it has. TTYOS and TTYIS * can be modified if needed to adjust for different config. * TTY EQU 11B default TTY slot TTYOS OCT 11 offset for driver instruction TTYIS OCT 102600 instruction that's supposed to be there SLTCL OCT 177700 mask to clear slot SLTGT OCT 77 mask to get slot TTYIN OCT 160000 TTY input command TTYOT OCT 120000 TTY output command MASKC OCT 177 mask for 7 bits PSLOT OCT 0 patch slot * * patch TTY slot, disable interrupts CONIO NOP CLA STA PSLOT clear slot to determine if patch occured LDA 102B get TTY driver link ADA TTYOS add TTY instruction offset STA 1 put in B reg LDA 1,I get instruction AND SLTCL mask off slot CPA TTYIS is it the instruction we're looking for? RSS yes, skip to do patch JMP NOPAT no, don't patch LDA 1,I get instruction AND SLTGT get slot STA PSLOT save LDB PLIST put start of patchlist in B JSB PATCH do the patch NOPAT CLF 0 disable interrupts JMP CONIO,I * * patch sub - patch list address in B PATCH NOP PATLP LDA 1,I get instruction address to patch STA ADTMP save LDA ADTMP,I get instruction to patch AND SLTCL mask off slot IOR PSLOT set to new slot STA ADTMP,I store patched instruction INB increment patchlist pointer LDA 1,I check next patch address SZA skip if zero JMP PATLP patch some more JMP PATCH,I ADTMP OCT 0 * * list of locations to patch PLIST DEF *+1 DEF TTYP1 DEF TTYP2 DEF TTYP3 DEF TTYP4 DEF TTYP5 DEF TTYP6 DEF TTYP7 DEF TTYP8 DEF TTYP9 DEF TTYPA OCT 0 * * get byte from console and put in parm GETCH NOP JSB GET1P parse parm to set address JSB CONIO set up for non-int I/O LDA TTYIN get TTY input command TTYP1 OTA TTY send to interface TTYP2 STC TTY,C start interface TTYP3 SFS TTY got char? JMP *-1 no, keep looping TTYP4 LIA TTY get char TTYP5 CLC TTY turn off interface AND MASKC mask char JSB UPDP1 update parm STF 0 reenable interrupts JMP GETCH,I * * send byte in parm to console PUTCH NOP JSB GET1P get parm JSB CONIO set up for non-int I/O LDA TTYOT get TTY output command TTYP6 OTA TTY send to interface LDA PAR1I get byte to send AND MASKC mask char TTYP7 OTA TTY send char to interface TTYP8 STC TTY,C start interface TTYP9 SFS TTY accepted? JMP *-1 no, keep looping TTYPA CLC TTY turn off interface STF 0 reenable interrupts JMP PUTCH,I * * binary saver * halts, when continued punches system * halts again, when continued re-enters BASIC * SVBIN LDA DFLPU get default punch AND SLTGT mask just slot address STA PSLOT save it for patch sub LDB PPLST get patch list JSB PATCH patch PTP slot HLT 7 halt w/ bits 0-2 lit JSB ZEROS write leader JSB ABSOT output ABS JSB ZEROS write trailer HLT 77B halt success JMP REENA,I re-enter BASIC REENA OCT 2027 * * sub to output range * STADR OCT 0 address to save from * ENADR OCT 0 address to save to * These moved to top of program and defined MEMCT OCT 0 mem counter RECCT OCT 0 record counter RECLM OCT 0 words in current record CHKSM OCT 0 record checksum RECSZ OCT 33 record size (words in each record) REMWD OCT 0 remaining words HIMSK OCT 177400 high-byte mask BMASK OCT 377 low-byte mask ABSOT NOP LDA STADR STA MEMCT set starting address * encode loop SVB1 LDA ENADR LDB MEMCT CMB,INB ADA 1 A = end - counter STA REMWD save remaining words to do SZA,RSS JMP ABSOT,I if 0 then at end, exit sub LDB RECSZ CMB,INB ADA 1 A = remaining - record size LDB RECSZ default record size SSA skip if complete record LDB REMWD number of words in last record STB RECLM save for record limit LDA 1 put in A JSB SSB write # words in record CLA JSB SSB write a zero byte LDA MEMCT get mem address STA CHKSM store in checksum AND HIMSK ALF,ALF JSB SSB send high byte of address LDA MEMCT AND BMASK JSB SSB send low byte of address CLA STA RECCT clear record counter * word loop SVB2 LDA MEMCT,I get word from memory LDB CHKSM ADB 0 STB CHKSM add to checksum STA 1 save mem word to buffer AND HIMSK ALF,ALF JSB SSB send high byte of word LDA 1 get buffered memory word AND BMASK JSB SSB send low byte of word ISZ MEMCT increment memory counter ISZ RECCT increment record counter LDA RECCT CPA RECLM done? RSS yes - skip to write checksum JMP SVB2 no - write more words LDA CHKSM AND HIMSK ALF,ALF JSB SSB write high byte of checksum LDA CHKSM AND BMASK JSB SSB write low byte of checksum JMP SVB1 loop to write another record * * sub to write leader/trailer ZEROS NOP LDB NZERC get negative zero count SZER1 CLA JSB SSB send zero byte ISZ 1 inc counter, skip if done JMP SZER1 send more zero bytes JMP ZEROS,I exit sub NZERC DEC -16 send 16 zero bytes * * punch out PUN EQU 13B SSB NOP PPAT1 OTA PUN PPAT2 STC PUN,C PPAT3 SFS PUN JMP *-1 PPAT4 CLC PUN JMP SSB,I * PPLST DEF *+1 list of PTP locations to patch DEF PPAT1 DEF PPAT2 DEF PPAT3 DEF PPAT4 OCT 0 * END