ASMB,A,B,L * * Overlay for BASIC 20392 * Version 2 at 74000 - Last mod 12/4/10 * Original version started 11/29/10 * * CALL(1) EXIT - jumps to 77000 to exit, restarting HP-IPL/OS * CALL(2) WEXIT - adds code to 77100 to "return" from BASIC * 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 * * New... v2 includes built-in PTP save menu, run from origin * No longer requires 21MX, uses BASIC subs for FP/int conversion * Calls 1 and 2 now check to make sure HP-IPL/OS is present (halt if not) * * Installation (using self)... * Load BASIC from PTR * Load Overlay from PTR * If desired load Octapus-D from PTR * Run BASIC from location 100 * Enter BYE to run punch menu * Patch run address and BYE behavior as desired * * Installation (using HP-IPL/OS with PTR/MS)... * Load BASIC (attach to PTR then ALTSAVE ZAM ABSLOAD) * Load this overlay on top of it (attach to PTR then ABSLOAD) * If desired load load Octapus-D (attach to PTR then ABSLOAD) * Run BASIC from location 100 (ALTRUN) * Enter BYE, exit to HP-IPL/OS and save binary (AM2ABS) * ORG 121B DEF LINKS DEF LKEND * patch run address as needed ORG 2 JMP 3,I * make following 100 for init, 2027 for edit, 5137 to autostart OCT 5137 * patch BYE to run menu ORG 76B DEF BEGIN JMP 76B,I * if inserting the following 4 code lines must be enabled * if adding after the drivers then comment the next 4 code lines * note - if inserting overlay must end before contents of loc 111 * 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 * set this to overlay location ORG 74000B BEGIN JMP BASOS jump to punch menu if run at orig OVEAD DEF LSTAD contains last address used by overlay * * link table... LINKS OCT 1 call 1 no parms DEF EXIT normal swap exit OCT 2 call 2 no parms DEF WEXIT exit to next word 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 * * Return code... swap main/alt (2-76001) then JMP 321,I * copy to 77100 then execute, mem from 76400-76777 used for buffer * ORG 77100B RCODE OCT 105734 OCT 105734 * SJP OCT 077102 DEF *+1 * just enable system map OCT 063131 LDA C2 OCT 073135 STA CADR * start at address 2 OCT 105745 LOOP OCT 105745 * LDX OCT 077134 DEF BSIZ * number of words, 400 octal OCT 063135 LDA CADR * source address OCT 067133 LDB BUFF * destination address = 76400 in alt OCT 105705 OCT 105705 * MWI move words into alt OCT 105745 OCT 105745 * LDX OCT 077134 DEF BSIZ * buffer size OCT 063135 LDA CADR * current address in alt OCT 067135 LDB CADR * current address in sys OCT 105706 OCT 105706 * MWF move words from alt map OCT 105745 OCT 105745 * LDX OCT 077134 DEF BSIZ * buffer size OCT 063133 LDA BUFF * source = buffer in alt OCT 067135 LDB CADR * dest = currentaddr in alt OCT 105707 OCT 105707 * MWW move words within alt map OCT 063135 LDA CADR OCT 043134 ADA BSIZ * add 400 oct to current address OCT 053132 CPA ENDA * if at end OCT 124321 JMP 321B,I * run HP-IPL/OS next code OCT 073135 STA CADR OCT 027104 JMP LOOP OCT 000002 C2 OCT 2 OCT 076002 ENDA OCT 76002 * terminate address OCT 076400 BUFF OCT 76400 * buffer at 76400-76777 OCT 000400 BSIZ OCT 400 * buffer size 256 words * CADR OCT 0 * current address RCLST EQU * * * jump to 77000 to exit (if stock swapper exists) EXIT NOP JSB CKIPL make sure HP-IPL/OS is present JMP *+1,I OCT 77000 * * word exit - copy return code to 77100 then jump to it WEXIT NOP JSB CKIPL make sure was run from HP-IPL/OS LDA RCBEG STA RCPTR LDB RDEST WLOOP LDA RCPTR,I STA 1,I ISZ RCPTR INB LDA RCPTR CPA RCEND JMP RDEST,I JMP WLOOP RCBEG DEF RCODE RCEND DEF RCLST RDEST OCT 77100 RCPTR OCT 0 * * check to make sure HP-IPL/OS is present CKIPL NOP LDA SWPAD,I get 1st instruction of swapper CPA SWPIN is it HP-IPL/OS JMP CKIPL,I yes, exit sub and do swap HLT 30B no, halt JMP *-1 stay halted SWPAD OCT 77000 SWPIN OCT 105734 * * 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 TTY 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 JSB CHRIN call char in sub JSB UPDP1 update parm STF 0 reenable interrupts JMP GETCH,I * CHRIN NOP 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 JMP CHRIN,I * * send byte in parm to console PUTCH NOP JSB GET1P get parm JSB CONIO set up for non-int I/O LDA PAR1I get byte to send JSB CHROT call char out sub STF 0 reenable interrupts JMP PUTCH,I * CHROT NOP LDB TTYOT get TTY output command TTYP6 OTB TTY send to interface 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 JMP CHROT,I * * A mini-OS for BASIC * for patching and punching system BASOS JSB CONIO patch tty slot JSB PATPU patch punch slot CLA STA ODFLG clear Octapus-D flag STA HOFLG clear HP-IPL.OS LDA ODADR,I get entry instruction for Octapus D CPA ODINS is it Octapus-D? STA ODFLG yes - enable display of Octapus option LDA SWPAD,I get swapper instruction CPA SWPIN is it HP-IPL/OS? STA HOFLG yes - enable display of HP-IPL/OS option MENU LDB MEN1T JSB PRTXT print 1st 5 options LDB MEN6T LDA ODFLG SZA JSB PRTXT print octapus option if present LDB MEN7T LDA HOFLG SZA JSB PRTXT print HP-IPL/OS option if present LDB MEN3T JSB PRTXT print prompt MENU1 JSB CHRIN CPA OPT1 punch binary JMP OPT1C CPA OPT2 patch run vector JMP OPT2C CPA OPT3 patch bye vector JMP OPT3C CPA OPT4 reenter basic JMP OPT4C CPA OPT5 print overlay help and reenter JMP OPT5C LDB ODFLG octapus present? SZB,RSS skip if it is JMP MENU2 check for more options CPA OPT6 JMP OPT6C MENU2 LDB HOFLG hpiplos present? SZB,RSS skip if it is JMP MENU3 check for more options CPA OPT7 JMP OPT7C MENU3 JMP MENU1 get another keystroke ODADR OCT 72400 location of Octapus-D entry ODINS OCT 62416 instruction there ODFLG OCT 0 flag for enabling Octapus menu option HOFLG OCT 0 flag for enabling HP-IPL/OS option MEN1T DEF *+1 OCT 6412 ASC 8,1) PUNCH BINARY OCT 6412 ASC 10,2) PATCH RUN VECTOR OCT 6412 ASC 10,3) PATCH BYE VECTOR OCT 6412 ASC 9,4) RE-ENTER BASIC OCT 6412 ASC 6,5) CALL HELP OCT 177777 MEN6T DEF *+1 OCT 6412 ASC 6,6) OCTAPUS-D OCT 177777 MEN7T DEF *+1 OCT 6412 ASC 6,7) HP-IPL/OS OCT 177777 MEN3T DEF *+1 OCT 6412 ASC 1,> OCT 177777 OPT1 DEC 49 OPT2 DEC 50 OPT3 DEC 51 OPT4 DEC 52 OPT5 DEC 53 OPT6 DEC 54 OPT7 DEC 55 CRLFT DEF *+1 OCT 6412 OCT 177777 OPT5C LDB OVLHO LDA SWPAD,I check swap location CPA SWPIN is HP-IPL/OS present JSB PRTXT yes - print exit calls LDB OVLHE print rest of help JSB PRTXT drop through to re-enter basic OPT4C LDB CRLFT JSB PRTXT print crlf JMP REENA,I re-enter basic editor OPT6C LDB CRLFT JSB PRTXT print crlf JMP ODADR,I run Octapus-D OPT7C LDB CRLFT JSB PRTXT print crlf JMP SWPAD,I exit to HP-IPL/OS OPT1C LDB SAVBT JSB PRTXT print attach prompt HLT 3 halt for attach LDB SAVBS JSB PRTXT print saving message JSB SAVBI punch the binary LDB SAVBD JSB PRTXT print detach prompt HLT 77B halt for detach JMP MENU SAVBT DEF *+1 OCT 6412 ASC 5,ATTACH PTP OCT 177777 SAVBS DEF *+1 OCT 6412 ASC 5,SAVING.... OCT 177777 SAVBD DEF *+1 OCT 6412 ASC 5,DETACH PTP OCT 177777 OPT2C LDB RVMET run vector menu JSB PRTXT RVME1 JSB CHRIN CPA OPT1 JMP PFINI patch for ini CPA OPT2 JMP PFAUT patch for autorun CPA OPT3 JMP PFREN patch for reenter JMP MENU RVMET DEF *+1 OCT 6412 ASC 9,RUN VECTOR OPTIONS OCT 6412 ASC 7,1) INIT (100) OCT 6412 ASC 9,2) AUTORUN (5137) OCT 6412 ASC 9,3) RE-ENTER (2027) OCT 6412 ASC 1,> OCT 177777 JMP3I OCT 124003 PFINI LDA JMP3I STA 2 LDA INITA STA 3 LDB INITT PTMEN JSB PRTXT JMP MENU INITA OCT 100 INITT DEF *+1 OCT 6412 ASC 6,RUN 2 INITS OCT 177777 PFAUT LDA JMP3I STA 2 LDA AUTOA STA 3 LDB AUTOT JMP PTMEN AUTOA OCT 5137 AUTOT DEF *+1 OCT 6412 ASC 7,RUN 2 AUTORUNS OCT 177777 PFREN LDA JMP3I STA 2 LDA REENA STA 3 LDB REENT JMP PTMEN REENA OCT 2027 REENT DEF *+1 OCT 6412 ASC 8,RUN 2 RE-ENTERS OCT 177777 OPT3C LDB BVM1T BYE vector menu JSB PRTXT print first 3 options LDB BVM2T LDA ODFLG SZA JSB PRTXT print octapus option if present LDB MEN3T JSB PRTXT print prompt BVME1 JSB CHRIN CPA OPT1 JMP BVHAL halt CPA OPT2 JMP BVPUM run punch menu CPA OPT3 JMP BVRHO run HP-IPL/OS LDB ODFLG octapus present? SZB,RSS skip if it is JMP MENU ignore keypress if not CPA OPT4 JMP BVROD run Octapus-D JMP MENU BVM1T DEF *+1 OCT 6412 ASC 9,BYE VECTOR OPTIONS OCT 6412 ASC 4,1) HALT OCT 6412 ASC 7,2) PUNCH MENU OCT 6412 ASC 12,3) RUN HP-IPL/OS (77000) OCT 177777 BVM2T DEF *+1 OCT 6412 ASC 12,4) RUN OCTAPUS-D (72400) OCT 177777 BVHAL LDA HLT77 STA 77B LDB BHLTT JMP PTMEN HLT77 HLT 77B BHLTT DEF *+1 OCT 6412 ASC 5,BYE HALTS OCT 177777 BVPUM LDA JM76I STA 77B LDA OVADR STA 76B LDB BRPMT JMP PTMEN JM76I OCT 124076 BRPMT DEF *+1 OCT 6412 ASC 10,BYE RUNS PUNCH MENU OCT 177777 BVRHO LDA JM76I STA 77B LDA SWPAD STA 76B LDB BVRHT JMP PTMEN BVRHT DEF *+1 OCT 6412 ASC 9,BYE RUNS HP-IPL/OS OCT 177777 BVROD LDA JM76I STA 77B LDA ODADR STA 76B LDB BVROT JMP PTMEN BVROT DEF *+1 OCT 6412 ASC 9,BYE RUNS OCTAPUS-D OCT 177777 * * print subroutine, address in B * terminates if bit 15 of text word set PRPTR OCT 0 print pointer PRTXT NOP STB PRPTR PRTX1 LDA PRPTR,I get packed double char SSA skip if sign is 0 JMP PRTXT,I exit sub if sign set AND HIMSK ALF,ALF JSB CHROT print high byte LDA PRPTR,I AND BMASK SZA skip if zero JSB CHROT print low byte ISZ PRPTR inc print pointer JMP PRTX1 loop to print more * * save ABS binary SAVBI NOP JSB ZEROS write out zero leader LDA EXT1F get start address (2) STA STADR save for sub LDA 113B get end of basic source STA ENADR save for sub JSB ABSOT punch it LDA 111B get start of basic drivers STA STADR save for sub AND MOADR mask off low address field IOR EODRV set to end of drivers STA ENADR save for sub JSB ABSOT punch it LDA AUXAD,I check to see if aux code present SZA,RSS skip if not zero JMP NOAXC no aux code jump to save overlay LDA AUXAD get start of aux code STA STADR save for sub LDA AUXEA get end of aux code STA ENADR save for sub JSB ABSOT punch it NOAXC LDA OVADR get start of overlay code STA STADR save for sub LDA OVEAD get end of overlay code STA ENADR save for sub JSB ABSOT punch it JSB ZEROS write out zero trailer JMP SAVBI,I EXT1F OCT 2 start address for save OVADR DEF BEGIN start of overlay (end in OVEAD) MOADR OCT 176000 mask to remove 1KW address EODRV OCT 1677 1KW end of basic drivers AUXAD OCT 70000 address of aux code (octapus-d) AUXEA OCT 72777 end of aux code space * * sub to output range STADR OCT 0 address to save from ENADR OCT 0 address to save to 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 * * patch punch slot PATPU NOP CLA STA PSLOT clear slot to determine if patch occured LDA 103B get PTP driver link ADA PTPOS add PTP instruction offset STA 1 put in B reg LDA 1,I get instruction AND SLTCL mask off slot CPA PTPIS is it the instruction we're looking for? RSS yes, skip to do patch JMP NOPUP no, don't patch LDA 1,I get instruction AND SLTGT get slot STA PSLOT save LDB PPLST put start of punch patchlist in B JSB PATCH do the patch NOPUP JMP PATPU,I PTPOS OCT 4 offset into PTP driver PTPIS OCT 102600 instruction to match PPLST DEF *+1 list of PTP locations to patch DEF PPAT1 DEF PPAT2 DEF PPAT3 DEF PPAT4 OCT 0 OVLHO DEF *+1 OCT 6412 ASC 13,CALL(1) RESTART HP-IPL/OS OCT 6412 ASC 13,CALL(2) REENTER HP-IPL/OS OCT 177777 OVLHE DEF *+1 OCT 6412 ASC 17,CALL(3,A,B) POKE B INTO ADDRESS A OCT 6412 ASC 17,CALL(4,A,B) PEEK ADDRESS A INTO B OCT 6412 ASC 18,(B IS SIGNED! SUB 65536 IF > 32767) OCT 6412 ASC 16,CALL(5,A) CALL SUB AT ADDRESS A OCT 6412 ASC 14,CALL(6,A) JUMP TO ADDRESS A OCT 6412 ASC 17,CALL(7,C) READ CONSOLE CHAR INTO C OCT 6412 ASC 17,CALL(8,C) WRITE CHAR C TO CONSOLE OCT 177777 * LSTAD OCT 0 * END