/ DEBUGGER FOR CONDOR APPLICATIONS / ........................... / : ....................... : / : : : : / : : : : / : : CPODT : : / : : : : / : :.....................: : / :.........................: / +---------------------------------------------------------------+ / | | / | DISCLAIMER AND EDIT HISTORY | / | | / +---------------------------------------------------------------+ / This program is produced and maintained by the WPS development / group (CC 3W1) for its own internal use. / 005 AIB ...14-JUL addition of symbol table & definition / 004 AIB 12-JUL-82 commands altered to mnemonic versions / 003 AIB 28-JUN-82 addition of PAL8 mnemonic interpretation / 002 AIB 22-JUN-82 addition of character interpretation on output / 001 AIB 17-JUN-82 addition of text error messages / 000 AIB 17-JUN-82 creation of version 1.0 / +---------------------------------------------------------------+ / | | / | DEFINITIONS AND PARAMETERS | / | | / +---------------------------------------------------------------+ / links to firmware OS8ENT= 7605 / restart OS8 ep REBOOT= 0200 / prime -- inject -- boot EOFPR= 0430 / end-of-frame interrupt processing sub KBYBD= 2415 / keyboard receive interrupt processing sub KBXMT= 3200 / keyboard transmit interrupt processing sub SLUIN= 1000 / display driver ep KBXQP= 3244 / keyboard transmit driver ep FLSAV= 0021 / panel firmware interrupt saved flags PCSAV= 0000 / panel firmware interrupt saved program counter ACSAV= 0020 / panel firmware interrupt saved AC reg MQSAV= 0023 / panel firmware interrupt saved MQ reg PSTAT= 0022 / panel firmware interrupt saved panel status word ATTRIB= 0120 / panel firmware CRT attributes G0FLAG= 0121 / panel firmware G0 character set G1FLAG= 0122 / panel firmware G1 character set LOCKED= 0026 / keyboard locked status (0 = not locked) HOLD= 0112 / hold screen mode flag (0 = locked) PUSHVC= 0154 / pointer to put-away sub for keyboard receive PSHSL= 4617 / put-away sub for keyboard receive ep MOD40= 0426 / panel firmware interrupt HLT processing block FWEXIT= 0460 / entry to panel interrupt return block EXIT3= 0476 / last chance to intercept exit from panel firmware / assembly & location parameters HDRFLD= 00 / main mem field for ODT loader MOVFLD= 10 / main mem field for ODT PRQFLD= 00 / instruction field of panel firmware ODTFLD= 70 / panel mem field for ODT execution PRQBGN= 7600 / locn of part of ODT in same field as panel firmware ODTBGN= 0020 / locn of ODT after installation / assembler extensions R3L= 7014 / rotate acc 3 bits left without link PGO= 6003 / (panel) clear HLT flag CPD= 6266 / (panel) clear panel data (switch indirects to main mem) SPD= 6276 / (panel) set panel data (switch indirects to panel mem) XX= SKP HLT / used to mark subroutine heads RDSPT= 6207 / acc = indicated stack pointer WRSPT= 6217 / indicated stack pointer = acc PTR1= 6207 / arg for RDSPT and WRSPT PTR2= 6227 / arg for RDSPT and WRSPT SKCFL= 6001 / if device done flag, then clear device flag and skip ORCLF= 6003 / acc = acc | data and clear flag (used with APU) WRSEQ= 6006 / data = acc, clear device done flag, start device TTY= 6040 / console output, seen from application MATTX= 6050 / keyboard transmit, seen from firmware FRAME= 6060 / display frame end flag USRIO= 6070 / flag set by 603N or 604N executed in main mem MATIN= 6110 / keyboard receive, seen from firmware APU= 6140 / Z80 aux processor unit PANEL= 6236 / (main) panel request MOVPM= 4000 / (after PANEL) move block from main mem to panel mem JMSPM= 6000 / (after PANEL) branch to panel mem location / some useful mnemonics ASCII= 177 / 7-bit mask to remove parity attached by PAL8 CARRTN= 15 / ASCII LNFEED= 12 / ASCII ESCAPE= 33 / ASCII LOCKBD= 211 / MAT COM UNLOCK= 213 / MAT COM INTKEY= 144 / MAT KEY / +---------------------------------------------------------------+ / | | / | CPODT LOADER This segment is loaded into main memory | / | in field MOVFLD and serves to copy the other seven segments | / | into panel memory in fields PRQFLD and ODTFLD. It then | / | starts CPODT at the proper location, ODTFLD:DEBUG. | / | | / +---------------------------------------------------------------+ FIELD HDRFLD%10 * 200 NOP CLA JMS TXEL JMS TXTMSG TEXT "CPODT VERSION 1.5, 14-JUL-82" JMS TXEL JMS TXTMSG TEXT "RUNS ONLY WITH FIRMWARE 0031" JMS TXEL ISZ (0 JMP .-1 NOP PANEL HDRFLD%10+PRQFLD+MOVPM HDRBGN PRQBGN HDRBGN-HDREND 7777 PANEL HDRFLD%10+PRQFLD+MOVPM HK1BGN EXIT3 HK1BGN-HK1END 7777 PANEL HDRFLD%10+PRQFLD+MOVPM HK2BGN MOD40&7600+177 HK2BGN-HK2END 7777 PANEL HDRFLD%10+PRQFLD+MOVPM HK3BGN MOD40 HK3BGN-HK3END 7777 PANEL HDRFLD%10+PRQFLD+MOVPM HK4BGN KBYBD&7600+177 HK4BGN-HK4END 7777 PANEL HDRFLD%10+PRQFLD+MOVPM HK5BGN KBYBD+3 HK5BGN-HK5END 7777 PANEL MOVFLD%10+ODTFLD+MOVPM MOVBGN ODTBGN MOVBGN-MOVEND 7777 PANEL ODTFLD+JMSPM DEBUG 7777 JMP I .+1 OS8ENT TXEL, XX TAD (15 JMS TXCH TAD (12 JMS TXCH JMP I TXEL TXTMSG, XX TAD I TXTMSG ISZ TXTMSG MQL MQA BSW JMS TXMS MQA JMS TXMS JMP TXTMSG+1 TXMS, XX AND (77 SNA JMP I TXTMSG TAD (40 AND (77 TAD (40 JMS TXCH JMP I TXMS TXCH, XX SKCFL TTY JMP .-1 WRSEQ TTY CLA JMP I TXCH / ------------------------ PAGE / +---------------------------------------------------------------+ / | | / | FIRMWARE LINKAGE This segment executes in panel | / | memory in the same field as the panel firmware (PRQFLD). It | / | provides for various cross-field references between the | / | panel firmware and CPODT. | / | | / +---------------------------------------------------------------+ HDRBGN, RELOC PRQBGN KBDINT, XX MQL MQA TAD MINTK SZA CLA JMP I KBDINT CIF CDF ODTFLD JMP I .+1 DBGINT MINTK, -INTKEY CALLAR, XX DCA SUBADR MQA JMS I SUBADR CDF CIF ODTFLD JMP I CALLAR SUBADR, 0 CATCH, XX CDF ODTFLD DCA I XCHAR CDF PRQFLD JMP I CATCH XCHAR, LATCH WAITLP, XX SKCFL MATIN JMP .+3 JMS I XKBYBD CLA SKCFL MATTX JMP .+3 JMS I XKBXMT CLA SKCFL FRAME JMP .+3 JMS I XEOFPR CLA JMP I WAITLP XKBYBD, KBYBD XKBXMT, KBXMT XEOFPR, EOFPR EXPTCH, XX ISZ EXPTCH SKCFL USRIO NOP TAD PSTAT CLL RTL RTL SMA CLA JMP I EXPTCH JMP I .+1 MOD40 RELOC HDREND, / +---------------------------------------------------------------+ / | | / | FIRMWARE MODIFICATIONS These five segments must be | / | written over certain locations in the panel RAM firmware. | / | | / +---------------------------------------------------------------+ HK1BGN, RELOC EXIT3 JMS I .+1 EXPTCH RELOC HK1END, HK2BGN, RELOC MOD40&7600+177 DBGHLT RELOC HK2END, HK3BGN, RELOC MOD40 CDF CIF ODTFLD JMP I MOD40&7600+177 RELOC HK3END, HK4BGN, RELOC KBYBD&7600+177 KBDINT RELOC HK4END, HK5BGN, RELOC KBYBD+3 JMS I KBYBD&7600+177 RELOC HK5END, / +---------------------------------------------------------------+ / | | / | DEBUG PROGRAM This segment executes in panel memory | / | in its own field (ODTFLD) and is linked to the panel firmware | / | by the linkage segment. This is the main & largest segment. | / | | / +---------------------------------------------------------------+ FIELD MOVFLD%10 * ODTBGN MOVBGN, / debug program control registers DBGCTL, ASCII&"M 0 SCHMSK, 7777 / mask used in "search" command ASCII&"S SCHBGN, 0 / beginning of range for a "search" command 0 ASCII&"F SCHEND, 7777 / end of range for a "search" command 7777 ASCII&"G GSTART, 0 / default starting address for a "go" command 200 0 DBGCTL+1 / parameters which determine current processor / the following 11 symbols must be kept together in order PLIST, / these 6 are set only when the processor is selected ADRRDX, ADRRDH / output format list for address size DATRDX, DATRDH / output format list for data size ADRMSK, 0007 / mask for hi word of address size DATMSK, 7777 / mask for data size PROCSW, 0 / 0 = 6120 selected; 2 = Z80 selected PROCTB, H6120R / pointer to saved machine state register list / these 4 are variables, initialized when the processor is selected MCHPTR, H6120R+1 / points to value field of currently opened machine register INPRFL, 0 / input radix flag: 0 = rdx 8; 1 = rdx 10; 2 = rdx 16 ADRRFL, 0 / address sized output radix flag: see INPRFL for definition DATRFL, 0 / data sized output radix flag: see INPRFL for definition / the next 6 locations must be kept in order / symbol typed by user SYMBOL, 0; 0; 0; 0 / double precision variables ARG, / if an argument was entered for the current command, ARGHI, 0 / it will be stored here and ARGCNT will be 1; if no ARGLO, 0 / argument was entered, ARG and ARGCNT will both be 0 CURR, / if a memory location is open for modification, its CURRHI, 0 / address will be stored here and OPNFLG will be 2 CURRLO, 0 LOOK, / dbl-pr temp, used in "search" command LOOKHI, 0 LOOKLO, 0 PSMA, / dbl-pr temp, used in subrs PSMAHI, 0 PSMALO, 0 PSDB, / dbl-pr temp, used in subrs PSDBHI, 0 PSDBLO, 0 DPTR, / used by DYPAL etc DPTRHI, 0 DPTRLO, 0 / single precision variables BRKFLG, 0 / 0 = no break set; 1 = break point set OPNFLG, 0 / 0 = nothing open; 1 = machine reg; 2 = program reg; 3 = mem PRGPTR, DBGCTL+1 / points to value field of currently open program register ARGCNT, 0 / 0 = no arg entered for this command; 1 = arg entered TRACE, 0001 / 0 = no report; 1 = report instr before single-stepping SYMFLG, 0001 / 0 = suppress CHAR & PAL8 reports; 1 = print reports CNTCNT, 0 / continue count for "single-step" and "continue" commands TEMP, 0 / whore LATCH, 0 / holds input from keyboard routine CHAR, 0 / holds input character in 7-bit ASCII, etc. RDXLIM, 0 / neg of radix, used to check input digits SBTMP, 0 / used by subroutines SYMBGN, 0 / current beginning of symbol table SYMEND= 7776 / end of symbol table SYMLOC, 0 / symbol table entry symbol pointer VALLOC, 0 / symbol table entry value pointer SYMCRS, 0 / temp used by symbol table routines SYMCCT, 0 / temp used by symbol table routines / subroutines used by main stem / subr -- add dbl-pr LOOK into dbl-pr ARG DPVAL, / var shares subr head DBLADD, XX CLL TAD ARGLO TAD LOOKLO DCA ARGLO RAL TAD ARGHI TAD LOOKHI DCA ARGHI JMP I DBLADD / subr -- shift dbl-pr ARG left one bit SYTMP, / var shares subr head DBLSHL, XX TAD ARGLO CLL RAL DCA ARGLO TAD ARGHI RAL DCA ARGHI JMP I DBLSHL / ------------------------ PAGE / main stem -- get optional arg & command char / here for new line & new command START, JMS I [CRLF / here for new command on same line DISCR, DCA ARGHI / prime arg DCA ARGLO DCA ARGCNT / signify no arg yet TAD INPRFL / prepare to use input radix as specified CLL RAL / by the input radix flag TAD (RLIST / (access parameter list) DCA TEMP TAD I TEMP / (set digit value limit) DCA RDXLIM ISZ TEMP TAD I TEMP / (set switch in main stem) DCA RDXSW NXDGT, JMS I [GETNXT / get next input char into CHAR TAD CHAR / do range checks on CHAR TAD (-"F!7600 SMA SZA JMP TXLST / :"F=%6000? TAD TEMP SZL JMS I [ERR / :yes, IOT or OPR, no memory reference ERRFEX= . / CANNOT FIND REFERENCE -- INSTRUCTION IS IOT OR OPR AND (200 / :no -- which page referenced? SZA CLA TAD (7600 / :current -- use addr<1-5> AND CURRLO / :zero -- use 0 DCA CURRLO TAD TEMP / add displacement = contents<6-11> AND (177 TAD CURRLO DCA CURRLO TAD TEMP / indirect? R3L SMA CLA JMP ODYMEM / :no -- go open memory JMS I [LOAD / :yes -- defer CURR DCA CURRLO TAD TEMP / contents>=%4000? SPA CLA JMP ODYMEM / :yes, JMP or JMS, defer is done TAD I [SVFL / :no -- change to data field AND (7 DCA CURRHI JMP ODYMEM / go open memory / command -- open location pointed to by current location XUNDLN, JMS I [QALTER / alter if arg & any open JMS I [ERR / :nothing was open ERINNO= . / CANNOT FIND INDIRECT -- NOTHING IS OPEN JMP XUND2 / :machine register was open JMS I [ERR / :program register was open ERINPO= . / CANNOT FIND INDIRECT -- PROGRAM REGISTER IS OPEN JMS I [PRCTST / :memory was open -- which processor? JMP XUND1 / :Z80 JMS I [LOAD / :6120 -- 12b indirect CURR DCA CURRLO JMP ODYMEM / go open memory XUND1, JMS I [LOAD / 16b indirect CURR DCA TEMP ISZ CURRLO SKP ISZ CURRHI NOP / eff nop const JMS I [LOAD CURR DCA CURRHI TAD TEMP DCA CURRLO JMP ODYMEM / go open memory XUND2, TAD MCHPTR / use register as pointer IAC DCA TEMP TAD I TEMP DCA CURRLO TAD I MCHPTR DCA CURRHI JMP ODYMEM / command -- execute in single-step mode XLFANG, JMS I [PRCTST / which processor? JMS I [ERR / :Z80, can't handle it ERSTZA= . / CANNOT STEP -- Z80 SELECTED JMS I [ARGTST / :6120 -- any arg? ISZ ARGLO / :no -- use 1 TAD ARGLO / :yes -- set continue count CMA IAC DCA CNTCNT XLFALP, TAD TRACE / trace mode on? SZA CLA JMS REPORT / :yes -- print instruction report HLT / :no -- restart main prog with halt flag set JMS EMLATE / so cpu will execute only one instr JMP HLTHIT / :HLT executed ISZ CNTCNT / :not a HLT -- continue? JMP XLFALP / :yes TAD (ASCII&"< / :no -- use "step" message JMP DYSTTH / display machine state / ------------------------ PAGE / command -- open successor to currently open XPRIME, JMS I [QALTER / alter if arg & any open JMS I [ERR / :nothing was open ERSCNO= . / CANNOT FIND SUCCESSOR -- NOTHING IS OPEN JMP XPRI1 / :machine register was open JMP XPRI2 / :program register was open ISZ CURRLO / :memory was open -- bump CURR JMP ODYMEM ISZ CURRHI JMP ODYMEM JMP ODYMEM / go open memory XPRI1, ISZ MCHPTR / bump reg pointer to next name ISZ MCHPTR TAD I MCHPTR / end of list? ISZ MCHPTR SZA CLA JMP ODYMCH / :no TAD I MCHPTR / :yes -- wrap to beginning DCA MCHPTR JMP ODYMCH XPRI2, ISZ PRGPTR / bump reg pointer to next name ISZ PRGPTR TAD I PRGPTR / end of list? ISZ PRGPTR SZA CLA JMP ODYPRG / :no TAD I PRGPTR / :yes -- wrap to beginning DCA PRGPTR JMP ODYPRG / display current address & open memory location ODYMEM, JMS I [CRLF / get a new line JMS I [DYADR / print CURR in address size CURR TAD (ASCII&"/ / signal memory open JMS I [PRCH / open memory location when addr is already displayed OPNMEM, JMS I [LOAD / get contents of current location CURR DCA TEMP TAD TEMP / print contents in data size JMS I [DYDAT TAD TEMP / print contents as characters JMS I [DYCHR CLA CLL / print contents as PAL8 mnemonics, in static JMS I [DYPAL / context (DF unknown) CURR CLA CLL CML IAC RAL / set open-flag to "memory" DCA OPNFLG JMP I [DISCR / next command / command -- open saved machine register XBAKSL, JMS I [XALTER / alter if arg & any open JMS I [GETNXT / get name of register into CHAR TAD PROCTB / look up name in current processor saved JMS LOOKUP / register list JMP ODYMCH / :it's "/" JMS I [ERR / :not "/" and not found ERUNMR= . / UNRECOGNIZED MACHINE REGISTER NAME DCA MCHPTR / :found, acc pts to data entry JMP OPNMCH ODYMCH, JMS I [CRLF / get a new line CLA CLL CMA / back up to name of entry TAD MCHPTR DCA TEMP TAD I TEMP / display name of register JMS I [PRCH OPNMCH, TAD (ASCII&"\ / indicate it's machine register JMS I [PRCH CLA CLL IAC / indicate machine register open DCA OPNFLG JMS I [PRCTST / which processor? JMP OPMC / :Z80 TAD MCHPTR / :6120 -- dump data in data size IAC DCA TEMP TAD I TEMP JMS I [DYDAT TAD I TEMP / print data as characters JMS I [DYCHR JMP I [DISCR / done OPMC, TAD MCHPTR / dump data in address size JMP OPRG / command -- open program control register XVRTLN, JMS I [XALTER / alter if arg & any open JMS I [GETNXT / get name of register into CHAR TAD (DBGCTL / look up name in debug program control JMS LOOKUP / register list JMP ODYPRG / :it's "/" JMS I [ERR / :not "/" and not found ERUNPR= . / UNRECOGNIZED PROGRAM REGISTER NAME DCA PRGPTR / :found, acc pts to data entry JMP OPNPRG ODYPRG, JMS I [CRLF / get a new line CLA CLL CMA / back up to name of entry TAD PRGPTR DCA TEMP TAD I TEMP / display name of register JMS I [PRCH OPNPRG, TAD (ASCII&"| / indicate it's program register JMS I [PRCH CLA CLL IAC RAL / indicate program register open DCA OPNFLG TAD PRGPTR / dump data in address size OPRG, DCA .+2 JMS I [DYADR 0 JMP I [DISCR / done / subr -- find register entry in list by name in CHAR / panel addr of register list is in accum / return+0: CHAR is "/" -- acc == 0 / return+1: fail, CHAR is not "/" and is not in the list / return+2: succ, acc pts to first word of data field of entry LOOKUP, XX DCA TEMP / set entry pointer TAD CHAR / check for "/" TAD (-"/!7600 SNA CLA JMP I LOOKUP ISZ LOOKUP LKLP, TAD I TEMP / get entry name ISZ TEMP / bump to entry value SNA / end of list? JMP I LOOKUP / :yes -- take fail return CMA IAC / :no -- name==CHAR? TAD CHAR SNA CLA JMP LKSC / :yes -- take succ return ISZ TEMP / :no -- bump to next entry ISZ TEMP JMP LKLP / try next entry LKSC, TAD TEMP / succ return ISZ LOOKUP JMP I LOOKUP / command -- close open location XCRETN, JMS I [XALTER / alter if arg & any open JMP I [START / next command / ------------------------ PAGE / command -- set or clear break point XRTANG, JMS I [ARGTST / any arg? JMP XRTA1 / :no -- clear break flag TAD ARGHI / :yes -- restrict ARG to memory size AND ADRMSK RAL / insure ARG hi bit is set CLL CML RAR DCA ARGHI XRTA1, TAD (BPLIST / set up table pointer & length to do entire DCA TEMP / table, if no BP # identified TAD (-12 DCA CNTCNT JMS I [GETNXT / get BP # char into CHAR TAD CHAR / do all BPs? TAD (-"/!7600 SNA JMP XRTA2 / :yes TAD ("/-"?!7600 / :no -- dump active BP list? SNA JMP BPDUMP / :yes TAD ("?-"9 / :no -- do which BP? SMA SZA JMS I [ERR ERUNBH= . / UNRECOGNIZED BREAKPOINT NAME TAD ("9-"0 SPA JMS I [ERR ERUNBL= . / UNRECOGNIZED BREAKPOINT NAME CLL RAL / set up table pointer & length to do just the TAD (BPLIST / one indicated BP DCA TEMP CLA CMA DCA CNTCNT XRTA2, TAD ARGHI / set all indicated BPs to ARG DCA I TEMP ISZ TEMP TAD ARGLO DCA I TEMP ISZ TEMP ISZ CNTCNT / end of BP list? JMP XRTA2 / :no -- do next BP TAD (BPLIST / :yes -- any BP now set? DCA TEMP / set up table pointer & length TAD (-12 DCA CNTCNT CLA CLL IAC / first, set BRKFLG DCA BRKFLG XRTA3, TAD I TEMP / then, scan for set BP ISZ TEMP ISZ TEMP SPA CLA / is it set? JMP I [START / :yes -- leave BRKFLG set ISZ CNTCNT / :no -- end of BP list? JMP XRTA3 / :no -- do next BP DCA BRKFLG / :yes, no BP is set -- clear BRKFLG JMP I [START / done BPDUMP, TAD (BPLIST / set up pointers for scan DCA BPDTMP / note -- CNTCNT is already set to -12 TAD (ASCII&"0 DCA CHAR BPDLP, TAD I BPDTMP / is this BP set? SMA CLA JMP BPDSK / :no -- skip to next BP JMS I [CRLF / :yes -- print BP report line JMS I [DYADR BPDTMP, 0 TAD (ASCII&"> JMS I [PRCH TAD CHAR JMS I [PRCH JMS I [SPACE BPDSK, ISZ BPDTMP / bump pointers to next BP ISZ BPDTMP ISZ CHAR ISZ CNTCNT / end of BP list? JMP BPDLP / :no -- do next BP JMP I [START / :yes -- done / command -- begin execution at specified address XCOLON, JMS I [ARGTST / any arg? JMP .+2 / :no -- use GSTART JMP XCOL1 / :yes -- use arg TAD GSTART+1 DCA ARGLO TAD GSTART DCA ARGHI XCOL1, CLA CLL CMA / set continue to count to 1 DCA CNTCNT TAD PROCTB / clear saved machine state DCA TEMP XCOL2, ISZ TEMP / set entry to 0 DCA I TEMP ISZ TEMP DCA I TEMP ISZ TEMP / end of list? TAD I TEMP SZA CLA JMP XCOL2 / :no -- do next entry JMS I [PRCTST / :yes -- which processor? JMP XCOL3 / :Z80 TAD ARGHI / :6120 -- set PC AND (7 MQL MQA R3L MQA DCA I [SVFL TAD ARGLO DCA I [SVPC JMP RESTRT / start 6120 main program XCOL3, TAD ARGLO / set Z80 PCR DCA SVPCR+1 TAD ARGHI DCA SVPCR JMP RUNZ80 / start Z80 APU / ------------------------ PAGE / command -- continue from point of interrupt XSEMIC, JMS I [ARGTST / any arg? ISZ ARGLO / :no -- use 1 TAD ARGLO / :yes -- set continue count CMA IAC DCA CNTCNT JMS I [PRCTST / which processor? JMP RUNZ80 / :Z80 -- start it / :6120 -- start main program / run program in 6120 main memory RESTRT, TAD BRKFLG / any breakpoint set? SNA CLA JMP REST2 / :no JMS BATTST / :yes -- any break addr == start addr? JMP REST1 / :no REST0, HLT / :yes -- execute 1 instr JMS EMLATE JMP HLTHIT / :HLT executed REST1, TAD (BPLIST / :not a HLT -- set traps DCA RESTA / set up table pointers & length TAD (INSLST DCA TEMP TAD (-12 DCA RDXLIM REST3, TAD I RESTA / is this BP set? SMA CLA JMP REST4 / :no -- skip to next BP JMS I [LOAD / :yes -- save instr in table RESTA, 0 DCA I TEMP TAD RESTA / set trap DCA RESTB TAD (HLT JMS I [STORE RESTB, 0 REST4, ISZ RESTA / incr table pointers ISZ RESTA ISZ TEMP ISZ RDXLIM / end of BP list? JMP REST3 / :no -- do next BP REST2, PGO / :yes -- restart main program JMS EMLATE NOP / :HLT was first instr -- continue TAD BRKFLG / :HLT other than first -- breakpoint set? SNA CLA JMP HLTHIT / :no, must be coded HLT TAD (BPLIST+22 / :yes -- restore instrs under breakpoints DCA RESTC / set up table pointers & length TAD (INSLST+11 DCA TEMP TAD (-12 DCA RDXLIM REST5, TAD I RESTC / is this BP set? SMA CLA JMP REST6 / :no -- skip to next BP TAD I TEMP / :yes -- restore instr from table JMS I [STORE RESTC, 0 REST6, CLA CLL CMA RAL / decr table pointers TAD RESTC DCA RESTC CLA CLL CMA TAD TEMP DCA TEMP ISZ RDXLIM / end (actually bgn) of BP list? JMP REST5 / :no -- do next BP CLA CLL CMA / :yes -- this will back up saved PC for test JMS BATTST / any break addr == HLT addr? JMP HLTHIT / :no, must be coded HLT CLA CLL CMA / :yes, breakpoint -- back up saved PC TAD I [SVPC DCA I [SVPC ISZ CNTCNT / continue? JMP REST0 / :yes TAD CHAR / :no -- use "break" message JMP DYSTTH / go display registers / subr -- test for (saved PC + accum) == any break point / accum = 0 to test next locn to be executed (restart addr) / accum = -1 to test locn most recently executed (HLT addr) / return+0: fail -- no break point matches / return+1: succ -- CHAR contains name of break point BATTST, XX TAD I [SVPC / set up address comparison CMA IAC DCA LOOKLO TAD I [SVFL RTR CLL CML RAR / trust me AND (4007 CMA IAC DCA LOOKHI TAD (BPLIST-1 / set up table pointer & length DCA TEMP TAD (-12 DCA RDXLIM TAD (ASCII&"0 DCA CHAR BTLP, ISZ TEMP / does this BP match? TAD I TEMP / test hi words ISZ TEMP TAD LOOKHI SZA CLA JMP BTFL / :no -- skip to next BP TAD I TEMP / :maybe -- test lo words TAD LOOKLO SZA CLA JMP BTFL / :no -- skip to next BP ISZ BATTST / :yes -- take succ return JMP I BATTST BTFL, ISZ CHAR / incr BP number ISZ RDXLIM / end of BP list? JMP BTLP / :no -- do next BP JMP I BATTST / :yes -- take fail return / ------------------------ PAGE / subr -- restart execution in 6120 main mem using saved machine state / if HLT flag is set, the 6120 will execute 1 instruction and then interrupt / if HLT flag is clear, the 6120 will execute until a HLT is encountered / all 6120 main mem HLTs come back to this subr / return+0: HLT was first (or only) instruction executed / return+1: HLT was not the first instruction, or HLTFLG was already set EMLATE, HLTHIT / prepared for primeval HLT JMS FETCH / see if first instruction to be executed AND (7403 / includes a HLT -- if not, bump return addr TAD (-7402 SZA CLA ISZ EMLATE TAD (PSHSL / direct mat dvc input to firmware silo CDF PRQFLD DCA I (PUSHVC TAD I (PSTAT / clear saved HLT flag so firmware can exit AND (7577 DCA I (PSTAT TAD I (LOCKED / was mat dvc (keyboard) locked? CDF ODTFLD SNA CLA JMP NOLCK2 / :no TAD (LOCKBD / :yes -- lock it again MQL TAD (KBXQP CDF CIF PRQFLD JMS CALLAR NOLCK2, JMS XFMOV / restore saved machine state & CRT attributes CDF ODTFLD CDF PRQFLD -7 SVFL; FLSAV SVPC; PCSAV SVAC; ACSAV SVMQ; MQSAV ATRSAV; ATTRIB G0FSAV; G0FLAG G1FSAV; G1FLAG TAD SVS1 WRSPT PTR1 TAD SVS2 WRSPT PTR2 CDF CIF PRQFLD JMP FWEXIT / go to panel firmware interrupt return block DBGINT, TAD (HLTHIT DCA EMLATE DBGHLT, DEBUG, CDF ODTFLD / HLT in main memory program comes here JMS XFMOV / record saved machine state & CRT attributes CDF PRQFLD CDF ODTFLD -7 FLSAV; SVFL PCSAV; SVPC ACSAV; SVAC MQSAV; SVMQ ATTRIB; ATRSAV G0FLAG; G0FSAV G1FLAG; G1FSAV RDSPT PTR1 DCA SVS1 RDSPT PTR2 DCA SVS2 TAD (CATCH / direct mat dvc input to variable CHAR CDF PRQFLD DCA I (PUSHVC TAD I (LOCKED / is mat dvc locked? CDF ODTFLD SNA CLA JMP NOLCK1 / :no TAD (UNLOCK / :yes -- unlock it (but leave LOCKED as is) MQL TAD (KBXQP CDF CIF PRQFLD JMS CALLAR NOLCK1, JMS I [DUMP / reset terminal for debug program output ESCAPE ASCII&"[ ASCII&"0 ASCII&"; ASCII&"7 / 1 = bold, 4 = underline, 5 = blink, 7 = reverse ASCII&"m 0 JMP I EMLATE / start or return to debugger ATRSAV, 0 G0FSAV, 0 G1FSAV, 0 / command -- inject & run bootstrap loader XGRAVE, TAD (HLTHIT / preset debug entry point DCA EMLATE TAD (PSHSL / direct mat dvc input to firmware silo CDF PRQFLD DCA I (PUSHVC PGO / restart RAM firmware from beginning -- it CDF CIF PRQFLD / will preset memory and hardware, then JMP REBOOT / inject and run the RX boot loader / ------------------------ PAGE / command -- search memory range under mask XQUOTE, TAD SCHBGN+1 / pointer = search begin DCA LOOKLO TAD SCHBGN AND ADRMSK DCA LOOKHI TAD ARGLO / set up search arg AND DATMSK AND SCHMSK CMA IAC DCA CHAR XQUOLP, TAD SCHEND / pointer > search end? AND ADRMSK CLL CMA CML IAC TAD LOOKHI SNL SZA JMP I [START / :yes -- next command SZL CLA JMP .+6 / :no TAD SCHEND+1 / :maybe... CLL CMA CML IAC TAD LOOKLO SNL SZA CLA JMP I [START / :yes -- next command JMS I [LOAD / :no -- check location LOOK DCA TEMP TAD TEMP / ( contents & mask ) == search arg? AND SCHMSK TAD CHAR SZA CLA JMP XQUONM / :no JMS I [CRLF / :yes -- display hit, addr & contents JMS I [DYADR LOOK TAD (ASCII&"/ JMS I [PRCH TAD TEMP JMS I [DYDAT TAD TEMP / print contents as characters JMS I [DYCHR CLA CLL / print contents as PAL8 mnemonics, in static JMS I [DYPAL / context (DF unknown) LOOK XQUONM, ISZ LOOKLO / bump pointer JMP XQUOLP ISZ LOOKHI / never skips because pointer <= search end JMP XQUOLP / command -- display all machine registers for current processor XEQUAL, JMS I [PRCTST / which processor? JMP XEQZ / :Z80 TAD (ASCII&"= / :6120 JMP DYSTTH XEQZ, TAD (ASCII&"= JMP DYSTTZ / coded HLT instruction encountered in main memory HLTHIT, TAD (ASCII&"@ / use "HLT" message / display saved 6120 machine state DYSTTH, JMS I [LNHEAD / indicate report type TAD (H6120R / point to 6120 reg list DCA TEMP DYSHLP, TAD I TEMP / get name of reg SNA / end of list? JMP I [START / :yes -- next command JMS I [PRCH / :no -- display name TAD (ASCII&"= JMS I [PRCH ISZ TEMP / display reg lo wd in data size ISZ TEMP TAD I TEMP JMS I [DYDAT ISZ TEMP / bump to next entry JMP DYSHLP / do next entry / run the Z80 APU and monitor it for a halt or failure RUNZ80, TAD ("| / not implemented yet / display saved Z80 APU machine state DYSTTZ, JMS I [LNHEAD / indicate report type TAD (Z80APU / point to Z80 reg list DCA TEMP TAD (-10 / must begin a new line after 8th reg DCA CNTCNT DYSZLP, TAD I TEMP / get name of reg SNA / end of list? JMP I [START / :yes -- next command JMS I [PRCH / :no -- display name TAD (ASCII&"= JMS I [PRCH ISZ TEMP / display reg in addr size TAD TEMP DCA .+2 JMS I [DYADR 0 ISZ TEMP / bump to next entry ISZ TEMP ISZ CNTCNT / 8th reg? JMP DYSZLP / :no -- do next entry JMS I [CRLF / :yes -- begin new line JMP DYSZLP / do next entry / errors and abortions come here ERR, XX CLA TAD (ERRLST-2 DCA TEMP ERLP, ISZ TEMP ISZ TEMP TAD I TEMP ISZ TEMP SNA JMP ERFN TAD ERR SZA CLA JMP ERLP ERFN, TAD I TEMP JMS I [TXMSG ISZ TEMP TAD I TEMP SZA JMS I [TXMSG JMP I [START / ------------------------ PAGE / command -- accept and define or delete symbols / first accept optional symbol from user, then check for arg / if no arg and no symbol, then purge symbol table / if no arg but symbol entered, then delete one symbol from table / if arg entered but no symbol, then delete first symbol with that value / if arg and symbol entered, and symbol is not in table, then / add symbol to table with that value / if arg and symbol entered, and symbol is found in table, then / change symbol value to arg XDEFSY, JMS GETSYM / get symbol from user JMP XDEF3 / :none JMS I [ARGTST / :ok -- any arg? JMP XDEF2 / :no JMS LOCSYM / :yes -- symbol in table? JMP .+2 / :no JMP XDEF1 / :yes TAD SYMLOC / add symbol and arg to table CMA TAD SYMBGN DCA SYMCCT CLA CMA TAD SYMBGN DCA 10 CLA CLL CML IAC RTL TAD SYMBGN DCA SYMBGN CLA CMA TAD SYMBGN DCA 11 INSYLP, ISZ SYMCCT JMP .+2 JMP INSYDN TAD I 10 DCA I 11 JMP INSYLP INSYDN, TAD (SYMBOL-1 DCA 10 TAD (-6 DCA SYMCCT INDNLP, TAD I 10 DCA I 11 ISZ SYMCCT JMP INDNLP JMP I [START / done XDEF1, TAD ARGHI / set value to arg DCA I VALLOC ISZ VALLOC TAD ARGLO DCA I VALLOC JMP I [START / done XDEF2, JMS LOCSYM / symbol in table? JMS I [ERR / :no ERNDNS= . / ? CANNOT DELETE -- SYMBOL NOT DEFINED JMP XDEF4 / :yes XDEF3, JMS I [ARGTST / any arg? JMP XDEF5 / :no JMS LOCVAL / :yes -- value in table? JMS I [ERR / :no ERNDNV= . / ? CANNOT DELETE -- VALUE NOT DEFINED XDEF4, JMS CONFRM / :yes -- last chance TAD SYMLOC / delete one table entry CMA TAD SYMBGN DCA SYMCCT CLA CLL CML IAC RTL TAD SYMLOC DCA SYMBGN DESYLP, ISZ SYMCCT JMP .+2 JMP I [START / done CLA CMA TAD SYMLOC DCA SYMLOC CLA CMA TAD SYMBGN DCA SYMBGN TAD I SYMLOC DCA I SYMBGN JMP DESYLP XDEF5, JMS CONFRM / last chance TAD (SYMEND / purge the table DCA SYMBGN JMP I [START / done / command -- accept and use symbol, or display table entries / first accept optional symbol from user, then check for arg / if no arg and no symbol, then display entire symbol table / if arg entered but no symbol, then display symbols with that value / if symbol entered (arg or no), then use it as an arg XUSESY, JMS GETSYM / get symbol from user JMP XUSE1 / :none JMS LOCSYM / :ok -- symbol in table? JMS I [ERR / :no ERNUNS= . / ? UNRECOGNIZED -- SYMBOL NOT DEFINED TAD I VALLOC / :yes -- set arg to value DCA ARGHI ISZ VALLOC TAD I VALLOC DCA ARGLO CLA IAC / mark arg as entered DCA ARGCNT JMP NXDGT / back to command processor XUSE1, JMS I [ARGTST / any arg? JMP XUSE2 / :no JMS LOCVAL / :yes -- value in table? JMS I [ERR / :no ERNPNV= . / ? CANNOT DISPLAY -- VALUE NOT DEFINED JMS PRENT / :yes -- print one table entry JMP I [START / done XUSE2, TAD SYMBGN / print entire symbol table XUSE3, DCA SYMLOC TAD SYMLOC TAD (-SYMEND SNA CLA JMP I [START / done JMS PRENT CLA CLL CML IAC RTL TAD SYMLOC JMP XUSE3 / ------------------------ PAGE / subr -- get optional symbol from the user / symbol is terminated by a space / return+0: user did not enter symbol (he just pressed space) / return+1: user entered a symbol -- first 6 chars packed at SYMBOL GETSYM, XX JMS GTCH / get input char into CHAR JMP I GETSYM / :space ISZ GETSYM / :non-space -- bump return DCA SYMBOL+1 / clear the text var SYMBOL DCA SYMBOL+2 DCA SYMBOL+3 TAD (SYMBOL / set up pointer & count DCA SYMCRS CLA CLL CMA RAL DCA SYMCCT GTSYLP, TAD CHAR / chars are packed 3 to 2 words CLL RTL RTL DCA I SYMCRS JMS GTCH / get input char into CHAR JMP I GETSYM / :space TAD CHAR / :non-space RTR RTR AND (17 TAD I SYMCRS DCA I SYMCRS ISZ SYMCRS TAD CHAR AND (17 BSW CLL RTL DCA I SYMCRS JMS GTCH / get input char into CHAR JMP I GETSYM / :space TAD CHAR / :non-space TAD I SYMCRS DCA I SYMCRS ISZ SYMCRS GTSYEX, JMS GTCH / get input char into CHAR JMP I GETSYM / :space ISZ SYMCCT / :non-space -- packed 4 words yet? JMP GTSYLP / :no -- go pack 2 more CLA CMA / :yes -- ignore chars until space DCA SYMCCT JMP GTSYEX / subr -- find an entry in the table by its symbol / the target symbol is in the 4-wd string var SYMBOL / return+0: not found -- SYMLOC points to the first entry with symbol greater / than the target symbol / return+1: found -- SYMLOC points to the entry's symbol, and VALLOC points to / the entry's value LOCSYM, XX TAD SYMBGN / set up entry pointer LCSYLP, DCA SYMLOC TAD SYMLOC / end of table? TAD (-SYMEND SNA CLA JMP I LOCSYM / :yes -- fail return TAD SYMLOC / :no -- compare symbols DCA VALLOC / set up word pointers & count TAD (SYMBOL-1 DCA 10 TAD (-4 DCA SYMCCT LCSYRP, TAD I VALLOC / compare words CLL CMA CML IAC TAD I 10 SNL SZA JMP LCSYNX / :entry < target -- try next symbol SZA CLA JMP I LOCSYM / :entry > target -- fail return ISZ VALLOC / :word matches -- try next word ISZ SYMCCT / all words tried? JMP LCSYRP / :no ISZ LOCSYM / :yes, symbol matches -- succ return JMP I LOCSYM LCSYNX, CLA CLL CML IAC RTL / bump to next entry TAD SYMLOC JMP LCSYLP / try again / subr -- find an entry in the table by its value / the target value is in the 2-wd integer var ARG / return+0: not found / return+1: found -- SYMLOC points to the entry's symbol, and VALLOC points to / the entry's value LOCVAL, XX TAD ARGHI / form negatives, to speed comparisons CMA IAC DCA LOOKHI TAD ARGLO CMA IAC DCA LOOKLO TAD SYMBGN / set up entry pointer LCVLLP, DCA SYMLOC TAD SYMLOC / end of table? TAD (-SYMEND SNA CLA JMP I LOCVAL / :yes -- fail return CLA CLL IAC RTL / :no -- set up value pointer TAD SYMLOC DCA VALLOC TAD I VALLOC / compare hi words TAD LOOKHI SZA CLA JMP LCVLNX / :different -- try next entry TAD VALLOC / :same -- compare lo words DCA 10 TAD I 10 TAD LOOKLO SZA CLA JMP LCVLNX / :different -- try next entry ISZ LOCVAL / :same -- succ return JMP I LOCVAL LCVLNX, CLA CLL CML IAC RTL / bump to next entry TAD SYMLOC JMP LCVLLP / try again / subr -- allow user the opportunity to confirm or abort a deletion CONFRM, XX TAD (CNFMSG JMS I [TXMSG JMS I [GETNXT TAD CHAR TAD (-"Y!7600 SZA CLA JMS I [ERR ERNCFM= . / * DELETION ABORTED JMP I CONFRM / ------------------------ PAGE / subr -- display one symbol table entry / SYMLOC points to entry PRENT, XX TAD SYMLOC DCA PRENX CLA CLL CMA RAL DCA SYMCCT JMS I [CRLF PRENLP, TAD I PRENX RTR RTR JMS PUTCH TAD I PRENX AND (17 CLL RTL RTL MQL ISZ PRENX TAD I PRENX BSW RTR AND (17 MQA JMS PUTCH TAD I PRENX JMS PUTCH ISZ PRENX ISZ SYMCCT JMP PRENLP JMS I [DYADR PRENX, 0 JMP I PRENT PUTCH, XX AND (177 SNA TAD (ASCII&" JMS I [PRCH JMP I PUTCH / ------------------------ PAGE / subr -- report next instr to be executed according to flags in SVFL and / program counter in SVPC; print address and contents REPORT, XX TAD (ASCII&"[ / indicate report type JMS I [LNHEAD JMS FETCH / also sets LOOK* to address DCA FETCH JMS I [DYADR / print address LOOK TAD FETCH / print contents JMS I [DYDAT CLA CLL IAC / print contents as PAL8 mnemonics, in dynamic JMS I [DYPAL / context (DF taken from saved flags) LOOK JMP I REPORT / done / subr -- fetch next instr to be executed according to flags in SVFL and / program counter in SVPC; leave complete address in LOOK* FETCH, XX TAD I [SVPC DCA LOOKLO TAD I [SVFL RTR RAR AND (7 DCA LOOKHI JMS I [LOAD LOOK JMP I FETCH / subr -- cross-field move utility / return+0: arg -- CDF for source field / return+1: arg -- CDF for target field / return+2: arg -- minus the number of words to move / return+3: arg -- source address of first word / return+4: arg -- target address of first word / return+5: arg -- source address of second word / return+6: arg -- target address of second word / ...etc source & target address pairs for etc words CHRTMP, / var shares subr head XFMOV, XX CLA TAD I XFMOV ISZ XFMOV DCA XFA TAD I XFMOV ISZ XFMOV DCA XFB TAD I XFMOV ISZ XFMOV DCA RDXLIM XFLP, TAD I XFMOV ISZ XFMOV DCA TEMP TAD I XFMOV ISZ XFMOV DCA CHAR XFA, 000 TAD I TEMP XFB, 000 DCA I CHAR CDF ODTFLD ISZ RDXLIM JMP XFLP JMP I XFMOV / subr -- if SYMFLG is set (<>0), print ASCII, SIXBIT, and COS-310 character / interpretation of argument in accum DYCHR, XX DCA CHRTMP / save arg TAD SYMFLG / extended reporting? SNA CLA JMP I DYCHR / :off JMS I [SPACE / :on TAD CHRTMP / print it as one ASCII char AND (177 TAD (-40 SPA JMP NULL1 TAD (40-177 SMA JMP NULL1 TAD (177 JMS I [PRCH JMP NULL2 NULL1, JMS BLANK NULL2, JMS I [SPACE TAD CHRTMP / print it as two SIXBIT chars BSW TAD (40 AND (77 TAD (40 JMS I [PRCH TAD CHRTMP TAD (40 AND (77 TAD (40 JMS I [PRCH JMS I [SPACE TAD CHRTMP / print it as two COS-310 chars BSW JMS DYCOS TAD CHRTMP JMS DYCOS JMS I [SPACE JMP I DYCHR / done / subr -- print one COS-310 character from accum DYCOS, XX AND (77 SNA JMP NULL3 TAD (37 JMS I [PRCH JMP I DYCOS NULL3, JMS BLANK JMP I DYCOS / subr -- print a blank to represent a NULL character BLANK, XX JMS I [DUMP ESCAPE ASCII&"[ ASCII&"0 ASCII&"m ASCII&"@ ESCAPE ASCII&"[ ASCII&"7 ASCII&"m 0 JMP I BLANK / ------------------------ PAGE / subr -- if SYMFLG is set (<>0), print the PAL8 mnemonics for the contents / of the indicated location interpreted as an instruction. The location is / required in order to complete the address calculations. DYPAL, XX DCA SBTMP / save static:dynamic flag TAD I DYPAL / get arg & bump return ISZ DYPAL DCA SYTMP TAD SYMFLG / extended reporting? SNA CLA JMP I DYPAL / :off -- exit JMS I [SPACE / :on TAD I SYTMP / make local copy of pointer DCA DPTRHI ISZ SYTMP TAD I SYTMP DCA DPTRLO JMS I [LOAD / get contents DPTR DCA DPVAL CLA CLL CML RTR / memory reference instruction? TAD DPVAL SZL JMP DYNMR / :no AND (200 / :yes -- make direct address CMA IAC AND DPTRLO MQL TAD DPVAL AND (177 MQA DCA DPTRLO JMS SYSCH / print mnemonics NOP / table is format 1 MRITBL JMS I [DYADR / print direct address DPTR TAD DPVAL / indirect? AND (400 SZA CLA JMP DYPL1 / :yes TAD DPVAL / :no -- instruction type? TAD (1000 SPA CLA JMP I DYPAL / :DCA, JMS, JMP -- exit JMP DYPL4 / :AND, TAD, ISZ DYPL1, TAD (ARROW2 JMS I [TXMSG TAD DPVAL / instruction type? SPA CLA JMP DYPL2 / :JMS, JMP TAD SBTMP / :AND, TAD, ISZ, DCA -- call type? SZA CLA JMP DYPL2 / :dynamic TAD (ASCII&"? / :static -- unable to determine data field JMS I [PRCH JMP DYPL5 DYPL2, JMS I [LOAD / make indirect address DPTR DCA DPTRLO TAD DPVAL / instruction type? SPA CLA JMP DYPL3 / :JMS, JMP -- use IF TAD I [SVFL / :AND, TAD, ISZ, DCA -- use DF AND (7 DCA DPTRHI DYPL3, JMS I [DYADR / print indirect address DPTR TAD DPVAL / instruction type? TAD (1000 SPA CLA JMP I DYPAL / :DCA, JMS, JMP -- exit DYPL4, TAD (ARROW1 / :AND, TAD, ISZ JMS I [TXMSG DYPL5, JMS I [LOAD / print contents of address DPTR JMS I [DYDAT JMP I DYPAL / exit DYNMR, CLA / it's OPR or IOT JMS SYSCH / print mnemonics NOP / table is format 1 OPRTBL JMS SYSCH / print mnemonics JMP SYJ1 / table is format 2 IOTTBL JMP I DYPAL / exit / subr -- called by DYPAL to search mnemonic tables / tables are of two formats: (1) each entry is 4 wds -- a mask, a neg match, / and a 2 wd text msg; (2) each entry is 4 wds -- a neg match, and a 3 wd text / msg. Each table is terminated with a single zero wd. Format (1) requires a / NOP at location SYINS, while format (2) requires a JMP SYJ1. For each entry / in a format (1) table, the word in DPVAL is anded with the mask and compared / with the match; if the result is equal, the 2 wd text msg is printed. For / each entry in a format (2) table, the word in DPVAL is compared with the / match; if the result is equal, the 3 wd text msg is printed. SYSCH, XX TAD I SYSCH / get NOP or JMP SYJ1 instruction ISZ SYSCH DCA SYINS TAD I SYSCH / get table address ISZ SYSCH SYLP, DCA SYTMP TAD I SYTMP / end of table? SNA JMP I SYSCH / :yes, done -- exit ISZ SYTMP / :no SYINS, 000 / NOP for format (1), JMP SYJ1 for format (2) AND DPVAL / mask TAD I SYTMP / compare CLL CML / 2 wd msg starts with wd 3 of entry JMP SYJ2 SYJ1, TAD DPVAL / compare CLL / 3 wd msg starts with wd 2 of entry SYJ2, SZA CLA / comparison result? JMP SYJ3 / :not equal -- skip printing RAL / :equal -- select wd 3 or wd 2 TAD SYTMP JMS I [TXMSG / print msg SYJ3, CLA CLL CML IAC RAL / bump pointer to next entry TAD SYTMP JMP SYLP / go do next entry / ------------------------ PAGE / subr -- if arg was entered & anything was open, alter it / signal what was open by return displacement / return+0: nothing was open / return+1: register was open (program or machine) / return+2: memory location was open DDTMP, / var shares subr head locn QALTER, XX TAD QALTER / set up return TAD OPNFLG DCA XALTER JMP XALT0 / alter if arg & any open / subr -- if arg was entered & anything was open, alter it RDXPTR, / var shares subr head locn XALTER, XX XALT0, JMS I [ARGTST / any arg? JMP XALTX / :no TAD OPNFLG / :yes -- what is open? SNA JMS I [ERR / :nothing is open ERMDNO= . / CANNOT MODIFY -- NOTHING IS OPEN CLL RAR SNA JMP XALT1 / :machine register is open SNL CLA JMP XALT2 / :program register is open TAD ARGLO / :memory is open -- change it JMS I [STORE CURR JMP XALTX XALT1, TAD MCHPTR / change machine register contents JMP XALT3 XALT2, TAD PRGPTR / change program register contents XALT3, DCA DDTMP TAD ARGHI DCA I DDTMP ISZ DDTMP TAD ARGLO DCA I DDTMP XALTX, DCA OPNFLG / set open flag to "nothing" TAD ADRRFL / set input radix to address output radix DCA INPRFL JMP I XALTER / exit / subr -- print address-sized number (dbl-pr) using current radix / number of digits printed depends on radix & current processor / return+0: arg = panel addr of 2 wd number / return+1: normal return GADIG, / var shares subr head locn DYADR, XX TAD I DYADR / get number pointer JMS GETADR / use number pointer CLA IAC / discard CDF result TAD DYADR / get return addr & bump it over arg DCA DYDAT / set up return from common code TAD PSMAHI / mask number to proper size for current proc AND ADRMSK DCA PSMAHI TAD ADRRFL / set input radix to most recent output radix DCA INPRFL TAD ADRRDX / select format for current processor TAD ADRRFL JMP DDAT0 / join common code / subr -- print data-sized number using current radix / number of digits printed depends on radix & current processor / 8 or 12 bit value is in the accum / return+0: normal return DYDAT, XX AND DATMSK / mask number to proper size for current proc DCA PSMALO DCA PSMAHI TAD DATRFL / set input radix to most recent output radix DCA INPRFL TAD DATRDX / select format for current processor TAD DATRFL / code common to DYADR & DYDAT DDAT0, DCA RDXPTR / select format for current radix TAD I RDXPTR DCA RDXPTR DADR1, ISZ RDXPTR / get digit weight (stored as negative) TAD I RDXPTR DCA PSDBHI ISZ RDXPTR TAD I RDXPTR DCA PSDBLO TAD (-12 / prime the gathering digit DCA GADIG DADR2, CLL / number" ARROW2, TEXT "==>" / confirmation prompt message CNFMSG, TEXT / "Y" TO DELETE:/ / table of error locations and err messages ERRLST, -ERUNCO; MSUNRC; MSCMND -ERDEIR; MSDEIR; 0 -ERRFNO; MSCNFR; MSNTIO -ERRFMO; MSCNFR; MSRGIO -ERRFPO; MSCNFR; MSRGIO -ERRFZA; MSCNFR; MSZ80S -ERRFEX; MSCNFR; MSIIIO -ERINNO; MSCNFI; MSNTIO -ERINPO; MSCNFI; MSPRIO -ERSCNO; MSCNFS; MSNTIO -ERUNMR; MSUNRC; MSMRGN -ERUNPR; MSUNRC; MSPRGN -ERSTZA; MSCNST; MSZ80S -ERUNBH; MSUNRC; MSBKPN -ERUNBL; MSUNRC; MSBKPN -ERMDNO; MSCNMD; MSNTIO -ERNDNS; MSCNDL; MSSYND -ERNDNV; MSCNDL; MSVLND -ERNUNS; MSUNRC; MSSYND -ERNPNV; MSCNPR; MSVLND -EROUTI; MSOUTI; MSABOR -ERNCFM; MSDELI; MSABOR 0; MSUNER; 0 / the messages referred to in the error list MSCNFR, TEXT "? CANNOT FIND REFERENCE" MSCNFI, TEXT "? CANNOT FIND INDIRECT" MSCNFS, TEXT "? CANNOT FIND SUCCESSOR" MSCNST, TEXT "? CANNOT STEP" MSCNMD, TEXT "? CANNOT MODIFY" MSCNDL, TEXT "? CANNOT DELETE" MSCNPR, TEXT "? CANNOT DISPLAY" MSUNRC, TEXT "? UNRECOGNIZED" MSNTIO, TEXT "-- NOTHING IS OPEN" MSRGIO, TEXT "-- REGISTER IS OPEN" MSPRIO, TEXT "-- PROGRAM REGISTER IS OPEN" MSZ80S, TEXT "-- Z80 SELECTED" MSIIIO, TEXT "-- INSTRUCTION IS IOT OR OPR" MSSYND, TEXT "-- SYMBOL NOT DEFINED" MSVLND, TEXT "-- VALUE NOT DEFINED" MSCMND, TEXT "COMMAND" MSMRGN, TEXT "MACHINE REGISTER NAME" MSPRGN, TEXT "PROGRAM REGISTER NAME" MSBKPN, TEXT "BREAKPOINT NAME" MSDEIR, TEXT "? DIGIT EXCEEDS CURRENT INPUT RADIX" MSOUTI, TEXT "* OUTPUT" MSDELI, TEXT "* DELETION" MSABOR, TEXT "ABORTED" MSUNER, TEXT "! -- NO ERROR HELP --" / ------------------------ MOVEND, $$