ALWAYS 23MAR4 READ ;23MAR4 .MCALL DIR$,GET$S,OPEN$R,CLOSE$,CALLR,QIOW$ ;**-1 ;************************************************************************ ;* * ;* MODULE: READ * ;* * ;* FUNCTION: READ HEX INPUT FILE * ;* * ;* INPUT PARAMETERS: * ;* * ;* R0 POINTS TO THE COMMAND LINE IN PROCESS * ;* * ;* OUTPUT PARAMETERS: * ;* * ;* R0 POINTS JUST BEYOND COMMAND LINE * ;* * ;* DESTROYS: ALL REGISTERS * ;* * ;* AUTHOR: KEVIN ANGLEY * ;* * ;* DATE: 24-AUG-82 * ;* * ;* REVISED BY: Chris Doran, Sira Ltd. * ;* * ;* DATE: Dec83-Feb84 * ;* * ;* MODIFICATIONS: * ;* Add extra formats: ROCKWELL, RCA, TEXAS, WHITESMITHS, * ;* RIM, BIN, HEX, OCTAL, SIRA, OBJECT, TASK, ABSOLUTE * ;* with originals rewritten to use common subroutines. * ;* Support EVEN, ODD, and STEP options to read back * ;* hi/lo PROM files etc., by calling standard FROMTH * ;* subroutine if READ is followed by FROM, ODD, or EVEN. * ;* Change GET$ to GET$S for overlaid version. * ;* Support program name specification where appropriate. * ;* Don't print start address/name if not given. * ;* Suppress statistics printout if NOECHO selected. * ;* * ;* 23MAR4 Scott Smith, Telex Computer Products, Raleigh, NC * ;23MAR4 ;* Included 'USE FOR READ' modifications. * ;23MAR4 ;* * ;23MAR4 ;************************************************************************ READ:: CLRB CMPFLG ; ENTRY POINT FOR READ - INDICATE NOT COMPARE BR READCMP ; BRANCH TO COMMON CODE COMPARE:: MOVB @%0,CMPFLG ; ENTRY POINT FOR COMPARE - INDICATE COMPARE MOV #IO.ATT,ATTDET+Q.IOFN ; Attach TI: so ^O will work DIR$ #ATTDET ; if we have a lot of differences READCMP: MOV #IO.DET,ATTDET+Q.IOFN ; (Re)set DPB to detach for exit MOV SP,RETSP ; Save SP for abnormal error exits MOVB #377,ERRFLG ; Set error flag <> 0 .IIF DF P$$OFF, CLRB WRNFLG ; Clear warning flag CLRB MOSTYP ; INDICATE THAT MOSTEK HEADER RECORD NOT YET FOUND CLRB TRAILER ; INDICATE THAT TRAILER RECORD NOT YET FOUND CLRL ADDVAL ; ASSUME NO OFFSETTING UPON READING ADDRESSES CLRB PART ; ASSUME NO PARTIAL READ CLR BCOUNT ; CLEAR COUNT OF BYTES LOADED THIS READ CLR DCOUNT ; Clear count of differences found MOV #1,STEP ; Default STEP to 1 if no range specification CLRL LOBOUND ; and lo bound to 0, MOV #177777,HIBOUND ; high bound to FFFFFFFF MOV #177777,HIBOUND+2 MOV RDDOM,USECNT ; Move domain into 'USE FOR READ' counter ;23MAR4 .PAGE .SBTTL COLLECT KEYWORDS GETKEY FROM ; IS FROM/THRU OPTION THERE? BEQ 12$ ; Yes, go call FROMTH GETKEY EVEN ; Range may also start EVEN BEQ 12$ GETKEY ODD ; Or ODD BNE 14$ ; Default to whole if none of these INC %0 ; Make any of them advance pointer by 4 chars 12$: SUB #4,%0 ; Point back to range start CALL FROMTH ; Get range like everybody else BCS 140$ ; Trap error 14$: GETKEY PLUS ; TRY FOR PLUS KEYWORD BNE 141$ ; NE: NO GOTS CALL GETHXL ; GET THE PLUS ADDRESS BCC 144$ ; CC: GOT IT 140$: JMP ERREXIT ; TAKE ERROR EXIT 141$: GETKEY MINUS ; TRY FOR MINUS KEYWORD BNE 148$ ; NE: NO GOTS CALL GETHXL ; GET THE MINUS ADDRESS BCC 143$ ; CC: GOT IT BR 140$ ; (ERREXIT) ; TAKE ERROR EXIT 143$: NEG R2 ; NEGATE THE MINUS ADDRESS NEG R1 SBC %2 ; in double-precision 144$: MOV R1,ADDVAL ; SET UP ADDVAL MOV R2,ADDVAL+2 148$: GETKEY PARTIAL ; TRY FOR PARTIAL READ BNE 153$ ; NE: NO GOTS INCB PART ; SET PARTIAL FLAG 153$: GETKEY FILE ; GET THE KEYWORD "FILE" BEQ 16$ ; EQ: GOT IT OUTPUT MSK ; MISSING KEYWORD BR 140$ ; (ERREXIT) ; TAKE ERROR EXIT 16$: CALL PARSE ; PARSE THE FILENAME BCS 140$ ; (ERREXIT) ; TAKE ERROR EXIT OPEN$R #FDB ; OPEN THE FILE FOR READ BCC 20$ ; CC: SUCCESS MOV #FOE+FOELEN-4,%0 ; FILE OPEN ERROR MOV FDB+F.ERR,%1 ; Get error code CALL PUTHX4 ; Put in error message OUTPUT FOE ; BR 140$ ; (ERREXIT) ; TAKE ERROR EXIT 20$: MOV #177777,LOADDR ; LOWEST ADDRESS ENCOUNTERED SO FAR IS FFFFFFFF MOV #177777,LOADDR+2 CLRL HIADDR ; CLEAR HIGHEST ADDRESS ENCOUNTERED SO FAR ; (LONG WORD) MOV #RNM+RNMLEN,%5 ; Address area for program name read MOV #8.,%2 ; Load count 21$: MOVB #SPACE,-(%5) ; Fill it with spaces SOB %2,21$ .PAGE .SBTTL INPUT SECTION ; ; REGISTER USAGE: ; ; R0 POINTS TO CURRENT LOCATION IN RECORD ; R1 CONTAINS VALUE BEING PROCESSED ; R2 CONTAINS CURRENT ADDRESS BEING FILLED (OFFSETTED) ; R3 HOLDS THE REAL ADDRESS (LOW WORD) ; R4 HOLDS THE REAL ADDRESS (HIGH WORD) ; R5 CONTAINS THE NUMBER OF DATA BYTES YET TO PROCESS THIS RECORD ; MOV RWFORMAT,%1 ; Load file format code BIT #1,%1 ; Do a QA check to avoid crash BNE 22$ ; Code mustn't be odd CMP %1,#F.MAX ; or > max (or -2) BLOS 50$ ; OK, go read .IIF NDF TCI, RTCI=. 22$: OUTPUT UFS ; "Unsupported format" ; THIS NEVER SHOULD HAPPEN JMP CLOSE ; TAKE ERROR EXIT WITH CLOSE 50$: MOV FORMTS(%1),%1 ; Fetch read routine and format flag BIC #1,%1 ; Lose binary bit flag (0) CALL @%1 ; Read defined type .PAGE .SBTTL REPORT ON FILE READ ; Return here, if successful, with: ; RNM name (if any, spaces still if not) ; %3/%4 transfer address, including ADDVAL, (0 if none) ; TRAILER <> 0 if we have had a trailer record. ; Issue a (non-fatal) error message if PART is <> 0 (no trailer ; allowed) but we have one anyway. The case of PART = 0 (trailer ; expected) and TRAILER = 0 (not found) is dealt with at NOTRAIL. REPORT: DIR$ #ATTDET ; Detach TI: in case ctrl/O'd CLRB ERRFLG ; No serious errors found (yet!) TSTB PART ; Partial READ? BEQ 40$ ; No, allow a trailer TSTB TRAILER ; Yes, did we get one? BEQ 40$ ; No, OK OUTPUT TRI ; "Trailer record ignored" .IIF DF P$$OFF, INCB WRNFLG ; Flag a warning CLR %3 ; Lose new transfer address CLR %4 40$: TSTB CMPFLG ; Compare? BEQ 51$ ; No, don't report no of differences MOV DCOUNT,%1 ; Get no of differences BNE 42$ ; Always print if non-zero TST QUIET ; But if messages suppressed BEQ 51$ ; Don't print redundant 0 42$: MOV #DCT+1,%0 ; Address differences count position CALL PUTHX4 ; in message MOVB #'s,DCT+DCTLEN-1 ; Assume count <> 1 DEC %1 ; But if it is BNE 50$ CLRB DCT+DCTLEN-1 ; suppress the 's' on differences 50$: OUTPUT DCT ; Print no of differences 51$: MOV #PRGNAM,%2 ; Address space for {new} name MOV #RNM+RNMLEN-8.,%0 ; and name just read CMPB @%0,#SPACE ; Any name read? BEQ 60$ ; No, skip store/check/print MOV #8.,%5 ; Yes, load length TSTB CMPFLG ; Is this a compare? BEQ 54$ ; No, read, store name 52$: CMPB (%0)+,(%2)+ ; Else compare bytes BNE 53$ ; Trap mismatch SOB %5,52$ ; Check whole name BR 55$ ; OK if all matches 53$: OUTPUT FNM,#FNMLEN+RNMLEN ; Else print file and current names .IIF DF P$$OFF, INCB WRNFLG ; Warn if different BR 60$ ; Go deal with transfer address 54$: MOVB (%0)+,(%2)+ ; New name, just copy it SOB %5,54$ 55$: TST QUIET ; Unless display suppressed, BEQ 60$ OUTPUT FNM ; print it 60$: MOV #RSSLEN,SAVLEN ; Short message if no transfer ; Subtract ADDVAL from transfer address (if any), double-precision. PUSH %3 ; First see if there is one BIS %4,(SP)+ BEQ 2270$ ; None, skip compare/store SUB ADDVAL,%3 ; Yes, remove ADDVAL SBC %4 SUB ADDVAL+2,%4 ; in double-precision MOV #RSMLEN,SAVLEN ; Have an xfer addr, so o/p full mesg TST CMPFLG ; IS THIS A COMPARE? BEQ 63$ ; EQ: NO, UPDATE TRANSFER VALUE CMP TRNSFR,R3 ; IS LOW WORD IDENTICAL? BNE 62$ ; NE: NO CMP TRNSFR+2,R4 ; IS HIGH WORD IDENTICAL? BEQ 227$ ; EQ: YES 62$: MOV #RDT+RDTLEN-8.,R0 ; FORMAT MESSAGE MOV TRNSFR,R1 ; WITH STORED VALUE MOV TRNSFR+2,R2 CALL PUTHXJ MOV R3,R1 ; PUT FILE VALUE INTO MESSAGE MOV R4,R2 MOV #FLT+FLTLEN-8.,R0 CALL PUTHXJ OUTPUT RDT,#RDTLEN+FLTLEN ; OUTPUT THE MESSAGE .IIF DF P$$OFF, INCB WRNFLG ; Warn if different BR 227$ ; AND CONTINUE 63$: MOV R3,TRNSFR ; UPDATE TRANSFER ADDRESS (LOW WORD) MOV R4,TRNSFR+2 ; UPDATE TRANSFER ADDRESS (HIGH WORD) 227$: MOV TRNSFR,R1 ; PUT TRANSFER ADDRESS IN MESSAGE MOV TRNSFR+2,R2 MOV #RDT+RDTLEN-8.,R0 CALL PUTHXJ 2270$: TST BCOUNT ; WAS THERE ANY DATA REALLY LOADED? BNE 228$ ; NE: ABSOLUTELY CLRL LOADDR ; EQ: NOT ANY, MUST CLEAR STATISTICS 228$: MOV LOADDR,R1 ; PUT LOWEST ADDR ENCOUNTERED IN MESSAGE MOV LOADDR+2,R2 MOV #RDL+RDLLEN-9.,R0 CALL PUTHXJ MOV HIADDR,R1 ; PUT HIGHEST ADDR ENCOUNTERED IN MESSAGE MOV HIADDR+2,R2 MOV #RDH+RDHLEN-9.,R0 CALL PUTHXJ MOV BCOUNT,R1 ; PUT BYTE COUNT INTO MESSAGE MOV #RDC+RDCLEN-5,R0 CALL PUTHX4 ; COMPUTE 16-BIT BYTE-WISE CHECKSUM OVER ; ENTIRE RANGE OF LOW - HIGH MOV LOADDR,R3 ; PUT LOW ADDRESS IN R3/R4 MOV LOADDR+2,R4 CALL VALID ; SUBTRACT OFFSET MOV R2,R5 ; FROM ADDRESS IN R5 MOV HIADDR,R3 ; PUT HIGH ADDRESS IN R3/R4 MOV HIADDR+2,R4 CALL VALID ; SUBTRACT OFFSET SUB R5,R2 ; PUT COUNT IN R2 INC R2 PUSH R5 ; SAVE FROM ADDRESS TEMPORARILY ON STACK MOV R2,R5 ; KEEP RUNNING COUNT IN R5 POP R2 ; KEEP CURRENT ADDRESS IN R2 CLR CSUM ; CLEAR TOTAL CHECKSUM 240$: CALL UNOFFSET ; TEMPORARILY UNOFFSET SO WE CAN VALIDATE CALL VALID ; MUST KEEP A VALID POINTER THROUGHOUT BCS 245$ ; CS: WENT INVALID - CANNOT COMPUTE CHECKSUM MOVB MEMORY(R2),R0 ; GET BYTE TO ADD BIC #177400,R0 ; CLEAR HIGH BYTE ADD R0,CSUM ; ADD THE NEW BYTE TO THE CHECKSUM INC R2 ; INCREMENT VIRTUAL MEMORY POINTER SOB R5,240$ ; REPEAT FOR COUNT MOV CSUM,R1 ; PUT SUM INTO R1 TST BCOUNT ; WAS THERE ANY DATA REALLY LOADED? BNE 241$ ; NE: ABSOLUTELY CLR R1 ; EQ: NO - JUST SHOW SUM OF 0000 241$: MOV #RDS+RDSLEN-5,R0 CALL PUTHX4 ; PUT OUT SUM DATA 243$: TST QUIET ; Did all that to set up HI/LOADDR BEQ CLOSE ; But don't print if quiet mode selected MOV #RSM,OUTDIR+Q.IOPL ; Set up statistics message, MOV SAVLEN,OUTDIR+Q.IOPL+2 ; length SAVLEN BR OUT ; AND CLOSE IT UP 245$: MOV #RDS+RDSLEN-5,R0 ; SHOW "????" FOR CHECKSUM MOV #4,R1 ; PUT 4 "?" 247$: MOVB #'?,(R0)+ SOB R1,247$ BR 243$ IOERROR: MOV #IOE+IOELEN,%0 ; File I/O error MOV FDB+F.ERR,%1 ; Get the error code CALL PUTHX4 ; Insert in message MOV #IOE,OUTDIR+Q.IOPL MOV #IOELEN,OUTDIR+Q.IOPL+2 OUT: DIR$ #OUTDIR ; OUTPUT CLOSE: CLOSE$ #FDB ; EXIT WITH CLOSE ERREXIT: MOV RETSP,SP ; Get stack right after abnormal exit DIR$ #ATTDET ; Detach TI: if {still} attached .IF DF P$$OFF ; Set HEX's exit status to WARNING if missing/unexpected trailer found, ; or COMPARE found a difference in name or transfer address. TSTB WRNFLG ; Warning required? BEQ 10$ ; No, just test for error DEC EXSTAT ; Yes, try to change success (1) to warning (0) BEQ 10$ ; Done if we get 0 INC EXSTAT ; If not, restore exit status to error 10$: .ENDC NEGB ERRFLG ; Set carry if error flag <>0 BCS 20$ NEG DCOUNT ; Or difference count <>0 20$: RETURN ; for final return ; Warning exit point for a format that expects a trailer record containing a ; start address, but finds EOF first. Message is suppressed if a PARTIAL ; file was declared. NOTRAIL:TSTB PART ; IF PARTIAL, NO ERROR MESSAGE BNE NOXFER ; NE: OK OUTPUT TRL ; NO TRAILER RECORD .IIF DF P$$OFF, INCB WRNFLG ; Set warning ; (Common) return point for formats which have no start address or trailer ; -- just finish at EOF. NOXFER: CLR %3 ; But no SA CLR %4 JMP REPORT ; Complete as if file read fully otherwise CSERROR: ; Checksum error exit: OUTPUT CSE ; Print message, and record: ; File read error exit. Display faulty record if ASCII, but not if binary. ERROR: 10$: MOV RWFORMAT,%1 ; Fetch format type BIT #1,FORMTS(%1) ; If format read routines entry is off BNE CLOSE ; This is binary. Can't display. just close MOV #RECORD,OUTDIR+Q.IOPL ; SET UP FOR OUTPUT MOV SAVLEN,OUTDIR+Q.IOPL+2 ; USE SAVED LENGTH BR OUT ; Show record HCERROR: ; Conversion error: OUTPUT HCE ; Print message BR ERROR ; and record ITERROR: OUTPUT IBT ; "Incorrect block type" BR ERROR BCERROR: OUTPUT IBC ; "Incorrect block count" BR ERROR .PAGE .SBTTL GET FILE RECORD ; Get next record from the file. Return to call+6 if all OK, to address ; in call+4 if EOF, else abnormally to IOERROR. ; ; On successful exit, %1 and SAVLEN contain record length, %0 addresses ; its start, and flags are set on length. GETREC: GET$S #FDB ; Get a record BCC 5$ ; Process if OK CMPB F.ERR(%0),#IE.EOF ; End-of-file? BNE IOERROR ; No, some other error MOV @(SP)+,-(SP) ; Take EOF action -- push address to handle it JMP @(SP)+ ; Return there 5$: ADD #2,@SP ; Normal return, skip EOF address MOV F.NRBD(%0),%1 ; Return record size MOV F.NRBD+2(%0),%0 ; and address MOV %1,SAVLEN ; Save length in case of error, and set flags RTS PC ; and exit ; Most common cases are a branch to "No trailer" error if eof found first: GETNOT: CALL GETREC ; Get record NOTRAIL ; Process early EOF RETURN ; Return to caller otherwise ; And EOF = trailer, for formats that don't have one: GETEND: CALL GETREC ; Get record NOXFER ; EOF -- just set transfer addr = 0 RETURN ; Return if not EOF .PAGE .SBTTL GET DATA BYTES/WORDS ; Read next two digits as a hex byte from the input record. Take error exit ; if unsuccessful, else and add to checksum, and return to caller with ; flags set on current value of checksum (0 at end of Intel record). ; Entry GETCSM is used to fetch checksum byte, which should equal total so far. GETCSM: NEG CSUM ; Negate checksum so far GETBYT: CALL GETHX2 ; Get hex byte BCC ADDBYT ; OK, add into {16-bit} checksum & return to caller BR ERROR ; Take error exit if it fails ; Read next four digits as a hex word, taking error exit as GETBYT on failure, ; or add (byte-wise) to checksum and return to caller. GETWRD: CALL GETBYT ; Get hi byte PUSH %1 ; Save it CALL GETBYT ; Get lo .IF DF M$$EIS BR ADDHI ; OR in stacked hi and return .IFF JMP ADDHI ; OR in stacked hi and return .ENDC ; Binary reads, for various binary object formats. ; Read a byte, checking for end-of-record. BINCSM: NEG CSUM ; Checksum test entry, like GETBYT BINBYT: DEC SAVLEN ; Decrement count BPL 10$ ; Off end of record if it becomes -ve CALL GETNOT ; Get another if so, shouldn't reach EOF BR BINBYT ; Try again while more data 10$: MOVB (%0)+,%1 ; Else fetch byte ADDBYT: BIC #^C377,%1 ; only ADD %1,CSUM ; Add to checksum TSTB CSUM ; Set flags on lo byte of checksum RETURN ; Return to caller or exit ; Read two bytes into a word, lo byte first. BINWRD: CALL BINBYT ; Get lo byte PUSH %1 ; Save lo byte CALL BINBYT ; Whilst fetching hi SWAB %1 ; Shift to hi byte BISB (SP)+,%1 ; OR in lo RETURN ; return with full word ; Tektronix-type reads -- checksum is formed from hex nybbles. DIGBYT: CALL GETBYT ; Get byte in the normal way PUSH %1 ; Save value BIC #^B1111,%1 ; Lose lo nybble SUB %1,CSUM ; Remove hi from checksum ASH #-4,%1 ; Shift hi nybble to lo ADD %1,CSUM ; Add in lo nybble POP %1 ; Restore %1 RETURN ; Return with it ; Get word similarly. DIGWRD: CALL DIGBYT ; Fetch hi byte PUSH %1 ; Save it CALL DIGBYT ; Fetch lo ADDHI: SWAB @SP ; Put 1st byte in hi byte on stack BIS (SP)+,%1 ; OR together RETURN ; and return ; Copy address in %1 to %3/%4, adding ADDVAL DPADR: MOV %1,%3 ; %1 is lo CLR %4 ; Unsigned sign extend ; Add ADDVAL to %3/%4. ADDADV: ADD ADDVAL,%3 ; Add lo ADC %4 ; and carry ADD ADDVAL+2,%4 ; Add hi RETURN .PAGE .SBTTL STORE OR COMPARE BYTE ; Inputs: ; %1 (lo) Byte value just read ; %3/%4 Real address to store in, including OFFSET and ADDVAL ; ; Outputs: ; %2 is unoffsetted address ; %3/%4 Address for next byte (%3/%4 input + STEP) ; LOADDR Revised lowest address ; HIADDR Revised highest address ; ; %1 is preserved (byte-swapped on STHCMP entry. ; ; Combines LOOK, PUTBYT, and MISMATCH plus common calling code, from Aug 82 ; version. STHCMP: SWAB %1 ; Entry to do hi byte STOCMP: ;23MAR4 TSTB USECNT ; Are we counting bytes? ;23MAR4 BEQ 40$ ; EQ: No - proceed ;23MAR4 DECB USECNT ; Counting bytes so decrement count ;23MAR4 BNE 65$ ; Not using this byte - exit ;23MAR4 TST USECNT ; Is thid the range count? (high byte = 1?) ;23MAR4 BEQ 30$ ; EQ: Domain count - continue processing ;23MAR4 MOV RDDOM,USECNT ; Reset the domain count ;23MAR4 BR 65$ ; and exit ;23MAR4 30$: TSTB RDRAN ; Are the domain and range equal? (ran-dom=0)vvv;23MAR4 BEQ 35$ ; YES - Move on ;23MAR4 MOV RDRAN,USECNT ; NO - Move range count into counter ;23MAR4 BR 40$ ; and process the byte ;23MAR4 35$: MOV RDDOM,USECNT ; reset the domain count and process the byte ;23MAR4 40$: CMP LOBOUND+2,R4 ; WITHIN RANGE? ;23MAR4 BNE 41$ ; If hi words differ, that determines it ;**-1 CMP LOBOUND,R3 ; HIGH WORDS SAME - HOW ABOUT LOW WORD? 41$: BHI 60$ ; OUT OF RANGE - IGNORE THIS DATA BYTE CMP HIBOUND+2,R4 ; WITHIN RANGE? BNE 42$ CMP HIBOUND,R3 ; HIGH WORDS SAME - HOW ABOUT LOW WORD? 42$: BLO 60$ ; OUT OF RANGE - IGNORE THIS DATA BYTE CMP LOADDR+2,R4 ; IS THIS A NEW LOW? BNE 45$ CMP LOADDR,R3 ; EQ: MAYBE - CHECK LOW WORD 45$: BLOS 46$ ; LO: DEFINITELY NO MOV R3,LOADDR ; UPDATE NEW LOW ADDRESS (LOW WORD) MOV R4,LOADDR+2 ; UPDATE NEW LOW ADDRESS (HIGH WORD) 46$: CMP HIADDR+2,R4 ; IS THIS A NEW HIGH? BNE 47$ CMP HIADDR,R3 ; EQ: MAYBE - CHECK LOW WORD 47$: BHIS 48$ ; HI: DEFINITELY NO MOV R3,HIADDR ; UPDATE NEW HIGH ADDRESS (LOW WORD) MOV R4,HIADDR+2 ; UPDATE NEW HIGH ADDRESS (HIGH WORD) 48$: INC BCOUNT ; Update total count CALL VALID ; Validate real address, 16-bit offset into %2 BCC 49$ ; OK, store byte JMP ERROR ; Errors are fatal (message already displayed) 49$: TSTB CMPFLG ; IS THIS JUST A COMPARE? BEQ 50$ ; EQ: NO, PROCESS LIKE A READ CMPB R1,MEMORY(R2) ; DOES IT MATCH? BEQ 60$ ; CONTINUE LIKE A READ INC DCOUNT ; Increment differences count ; Show mismatch: ; ; R2 CONTAINS THE OFFSETTED ADDRESS ; R3/4 CONTAINS THE UN-OFFSETTED ADDRESS ; R1 CONTAINS THE VALUE OBTAINED FROM THE FILE ; PUSH R0 ; SAVE READ POINTER PUSH R1 ; SAVE FILE VALUE PUSH R2 ; SAVE OFFSETTED VALUE MOV #AMF+39.,R0 ; PUT FILE VALUE INTO MESSAGE CALL PUTHAS ; In hex and ASCII MOVB MEMORY(R2),R1 ; GET MEMORY VALUE MOV #AMF+27.,R0 ; PUT INTO MESSAGE CALL PUTHAS ; In hex and ASCII MOV R3,R1 ; SET UP UN-OFFSETTED 32-BIT ADDRESS MOV R4,R2 MOV #AMF+10.,R0 ; PUT INTO MESSAGE CALL PUTHXJ OUTPUT AMF ; PUT THE MESSAGE OUT POP R2 ; RESTORE THE OFFSETTED VALUE POP R1 ; RESTORE THE FILE VALUE POP R0 ; RESTORE READ POINTER BR 60$ ; CONTINUE LIKE A READ 50$: MOVB R1,MEMORY(R2) ; PUT BYTE INTO VIRTUAL MEMORY 60$: INCR34 STEP ; Increment load address 65$: RETURN ; exit ;23MAR4 .PAGE ;**-1 .SBTTL READ INTEL FORMAT FILE ; :bbaaaattdddd...ddcc ; where: ; bb = data byte count ; aaaa = load address ; tt = block type: 00 = data, 01 = EOF no SA, 02 = EOF + SA ; dd...dd = data bytes ; cc = checksum, -(bb+aa+aa+tt+dd+...+dd) RINTEL: CALL GETNOT ; Get a record, EOF is "no trailer" CLRB RECORD(R1) ; MAKE ASCIZ 30$: TSTB (R0) ; END OF RECORD? BEQ RINTEL ; EQ: YES - GET ANOTHER CMPB #':,(R0)+ ; COLON FOUND? BNE 30$ ; NE: NO, KEEP LOOKING CLR CSUM ; Clear checksum CALL GETBYT ; GET DATA COUNT MOVB R1,R5 ; INITIALIZE DATA COUNT CALL GETWRD ; GET ADDRESS to %1 CALL DPADR ; Move to %3/%4, adding ADDVAL CALL GETBYT ; GET RECORD TYPE TSTB R1 ; <> zero - must be trailer record BNE 200$ ; NE: process trailer record TSTB R5 ; ZERO COUNT - MUST BE TRAILER RECORD BEQ 200$ ; EQ: PROCESS TRAILER RECORD 40$: ; PROCESS A DATA BYTE CALL GETBYT ; GET THE DATA BYTE CALL STOCMP ; Store or compare SOB R5,40$ ; CONTINUE FOR DATA COUNT CALL GETBYT ; GET CHECKSUM, SHOULD TOTAL 0 BEQ RINTEL ; EQ: YES - PROCESS ANOTHER RECORD 210$: ; HANDLE BAD CHECKSUM JMP CSERROR ; CHECKSUM ERROR 200$: ; PROCESS TRAILER RECORD INCB TRAILER ; NOTE WE HAD ONE CALL GETBYT ; GET THE CHECKSUM BNE 210$ ; EQ: O.K., NE, error 220$: RETURN ; Return, SA already in %2 .PAGE .SBTTL READ MOTOROLA FORMAT FILE ; Stbbaaaadddd...ddcc ; where: ; t = block type: 0 = header, 1 or 2 = data, 9 or 8 = EOF ; bb = byte count, including checksum and address ; aaaa = load address ; dd...dd = data bytes ; cc = checksum such that bb+aa+aa+tt+dd+...+dd+cc = $FF RMOTOROLA: CALL GETNOT ; Get a record, EOF is "no trailer" CLRB RECORD(R1) ; Make ASCIZ 30$: TSTB (R0) ; End of record? BEQ RMOTOROLA ; EQ: yes - get another CMPB #'S,(R0)+ ; 'S' found? BNE 30$ ; NE: no, keep looking MOV #1,CSUM ; Preset checksum to give total of 0 MOVB (%0)+,%2 ; Get record type flag CALL GETBYT ; Get data count MOVB R1,R5 ; Initialize data count SUB #3,%5 ; Less address and c/sum BPL 32$ ; Must be >=0 now JMP ITERROR ; Invalid record if not 32$: CLR %4 ; Clear address hi in case type 1 or 9 ; Records type 2 and 8 have 3-byte address. CMPB %2,#'2 ; Type 2? BNE 33$ ; No, try 8 DEC %2 ; Yes, process as type 1 from now on BR 34$ ; Get address hi 33$: CMPB %2,#'8 ; Check type 8 BNE 35$ ; No, should have normal 2-byte address INC %2 ; Else type 8 = type 9 (trailer) 34$: CALL GETBYT ; Get address bits 16-23 BISB %1,%4 ; to address hi DEC %5 ; Decrement count 35$: CALL GETWRD ; Get address lo MOV R1,R3 ; completing address in %3/%4 CALL ADDADV ; Add in ADDVAL CMPB %2,#'1 ; Data record? BEQ 37$ ; Yes, go process CMPB %2,#'0 ; Start record (0)? BEQ 300$ ; Yes, go process CMPB %2,#'9 ; Trailer (9)? BEQ 200$ JMP ITERROR ; No, invalid record type 37$: ; 1: process a data byte TST %5 ; Make sure we have one BLE 60$ ; No, just checksum 40$: CALL GETBYT ; Get the data byte CALL STOCMP ; Store or compare SOB R5,40$ ; Continue for data count 60$: CALL GETBYT ; Get checksum, should total 0 BEQ RMOTOROLA ; EQ: yes - process another record 70$: ; Handle bad checksum JMP CSERROR ; Checksum error ; Trailer record, should be: S903aaaacc or S804aaaaaacc ; but Whitesmith's hex utility gives: S905aaaa0000cc, so skip any data bytes. 200$: ; Process trailer record INCB TRAILER ; Note we had one INC %5 ; Fetch any dummy data and checksum 210$: CALL GETBYT ; But don't do anything with the data SOB %5,210$ ; Real SOB leaves flags unchanged from csum GETBYT .IIF NDF M$$EIS, TSTB CSUM ; but simulated one destroys them BNE 70$ ; EQ: O.K., NE, error 220$: RETURN ; Return, SA already in %2 ; Header record: S0bbaaaannnn...nncc ; nn...nn is program NAM, hex-encoded ASCII 300$: TST %5 ; Any name given? BEQ 60$ ; No, just check the checksum MOV #RNM+RNMLEN-8.,%2 ; Address record name storage 310$: CALL GETBYT ; Fetch a name byte CMP %2,#RNM+RNMLEN ; Room to store it? BHIS 320$ ; Don't store if we have 8 already MOVB %1,(%2)+ ; Else put in new name area 320$: SOB %5,310$ ; Repeat for whole of name BR 60$ ; Check checksum and go for next record .PAGE .SBTTL READ ROCKWELL FORMAT FILE ; ;bbaaaadddd...ddcccc ; where: ; bb = no of data bytes, dd...dd ; aaaa = start address ; cccc = checksum bb+aa+aa+dd+...+dd RROCKWELL: MOV ADDVAL,RECCNT ; Clear record counter MOV ADDVAL+2,RECCNT+2 ; allowing for ADDVAL offset 10$: CALL GETNOT ; Get a record, EOF is "no trailer" CLRB RECORD(R1) ; Make ASCIZ 30$: TSTB (R0) ; End of record? BEQ 10$ ; EQ: yes - get another CMPB #';,(R0)+ ; Semicolon found? BNE 30$ ; NE: no, keep looking CLR CSUM ; Clear checksum CALL GETBYT ; Get data count MOVB R1,R5 ; Initialize data count CALL GETWRD ; Get address, CALL DPADR ; including ADDVAL, to %3/%4 TSTB R5 ; Zero count - must be trailer record BEQ 200$ ; EQ: process trailer record ADD #1,RECCNT ; NE: data record, count it ADC RECCNT+2 40$: ; Process a data byte CALL GETBYT ; Get the data byte CALL STOCMP ; Store or compare SOB R5,40$ ; Continue for data count CALL 300$ ; Check checksum, return only if OK BR 10$ ; for another record 200$: ; Process trailer record INCB TRAILER ; Note we had one CALL 300$ ; Get and test the checksum CMP RECCNT,%3 ; "Address" is no of records in file, BNE 210$ ; excluding trailer record CMP RECCNT+2,%4 BEQ 220$ ; OK if matches no counted, else 210$: JMP BCERROR ; "Invalid block count" 220$: JMP NOXFER ; Return, no transfer address ; Get and check checksum. 300$: PUSH CSUM ; Push checksum so far CALL GETWRD ; Get checksum CMP %1,(SP)+ ; C.f. byte sum, should be same BEQ 320$ ; Yes - process another record JMP CSERROR ; No, checksum error 320$: RETURN ; Yes, return .PAGE .SBTTL READ RCA FORMAT FILE ; aaaa dd dd dd ...dd ; ; where: ; aaaa = load address ; dd ... = data ; individual items end with spaces, end of record should be a semicolon. RRCA: CALL GETEND ; Get a record; EOF is end of data 30$: CALL GETWRD ; Get address CALL DPADR ; Current address goes in %3/%4 40$: CMPB (%0)+,#SPACE ; Does value end space? BEQ 45$ ; Yes, get data JMP HCERROR ; No, conversion error 45$: CMPB @R0,#'; ; End of record? BEQ RRCA ; EQ: yes - get another CALL GETBYT ; No, get the data byte CALL STOCMP ; Store or compare BR 40$ ; Look for another, or end of record .PAGE .SBTTL READ STANDARD TEKTRONIX (TEKHEX) FORMAT FILE ; /aaaabbhhdddd...ddcc ; where: ; aaaa = start address ; bb = no of data bytes, dd...dd ; hh = header checksum a+a+a+a+b+b ; cc = data checksum d+d+...+d+d RTEKHEX: CALL GETNOT ; Get a record, EOF is "no trailer" CLRB RECORD(R1) ; Make ASCIZ 30$: TSTB (R0) ; End of record? BEQ RTEKHEX ; EQ: yes - get another CMPB #'/,(R0)+ ; Slash found? BNE 30$ ; NE: no, keep looking CMPB #'/,@%0 ; // is abort block BNE 35$ ; anything else should be data INCB TRAILER ; Note we had a trailer JMP NOXFER ; Abort block means no transfer address 35$: CLR CSUM ; Clear checksum CALL DIGWRD ; Get address CALL DPADR ; Current + ADDVAL address goes in %3/%4 CALL DIGBYT ; Get data count MOVB R1,R5 ; Initialize data count CALL GETCSM ; Get header checksum BNE 50$ ; Total should now be 0. Error if not TSTB R5 ; Zero count - must be trailer record BEQ 220$ ; EQ: all done 40$: ; Process a data byte CALL DIGBYT ; Get the data byte CALL STOCMP ; Store or compare SOB R5,40$ ; Continue for data count CALL GETCSM ; Check checksum BEQ RTEKHEX ; EQ: OK, go for another record 50$: JMP CSERROR ; NE: error 220$: INCB TRAILER ; Note we had a trailer RETURN ; Return, SA already in %3/%4 .PAGE .SBTTL READ EXTENDED TEKHEX RECORD ; %bbtccna...adddd...dd ; where: ; bb = no of data bytes, dd...dd ; t = block type, 6 = data, 3 = symbol, 8 = trailer ; cc = checksum b+b+t+n+a+...+a+d+d+...+d+d ; n = no of digits of load address ; a...a = start address, n digits ; d...d = data ; Equates for extended TekHex block types: DATA = '6 ; DATA RECORD SYMB = '3 ; SYMBOL TABLE RECORD TERM = '8 ; TERMINATION RECORD REXTENDED: CALL GETNOT ; Read record, EOF is "no trailer" CLRB RECORD(%1) ; Make it ASCIZ 5$: TSTB (R0) ; END OF RECORD? BEQ REXTENDED ; EQ: YES - GET ANOTHER CMPB #'/,@%0 ; / found? BNE 10$ ; No, try percent CMPB (%0)+,@%0 ; Yes, see if followed by another BNE 5$ ; Keep looking for % if not INCB TRAILER ; Call it a trailer JMP NOXFER ; // is an abort block without transfer address 10$: CMPB #'%,(R0)+ ; PERCENT FOUND? BNE 5$ ; NE: NO, KEEP LOOKING CALL CHECK ; VERIFY BLOCK SIZE AND CHECKSUM CMPB #DATA,(R0) ; IS THIS A DATA RECORD? BEQ 34$ ; EQ: YES, PROCESS A DATA RECORD CMPB #SYMB,(R0) ; IS THIS A SYMBOL TABLE RECORD? BEQ 100$ ; Yes, go get name CMPB #TERM,(R0) ; IS THIS A TRAILER RECORD? BEQ 200$ ; EQ: PROCESS TRAILER RECORD JMP ITERROR ; NE: "INVALID BLOCK TYPE" 34$: ADD #3.,R0 ; SKIP DATA TYPE AND CHECKSUM (ALREADY CHECKED) CALL GETHXV ; GET VARIABLE LENGTH HEX LOAD ADDRESS ; INTO R1 (LOW WORD) AND R2 (HIGH WORD) BCS 250$ ; CS: TAKE ERROR EXIT MOV BLKLEN,R5 ; COMPUTE NUMBER OF DATA BLOCKS SUB R3,R5 ; SUBTRACT LENGTH OF VARIABLE FIELD SUB #5,R5 ; SUBTRACT BLK CNT, CHKSUM, TYPE FIELD ASR R5 ; DIVIDE BY TWO TO GIVE NUMBER OF DATA PAIRS BCC 38$ ; CC: EVEN DATA PAIRS JMP BCERROR ; CS: "INVALID BLOCK COUNT" 38$: MOV R1,R3 ; PUT LOAD ADDRESS INTO R3 (LOW WORD) MOV R2,R4 ; PUT LOAD ADDRESS INTO R4 (HIGH WORD) CALL ADDADV ; + ADDVAL TST R5 ; ANY PAIRS TO PROCESS? BEQ REXTENDED ; EQ: NONE THIS RECORD 40$: CALL GETHX2 ; GET THE DATA BYTE BCS 250$ ; CS: TAKE ERROR EXIT CALL STOCMP ; Store or compare 65$: SOB R5,40$ ; DECREMENT NUMBER OF PAIRS TO READ ;23MAR4 BR REXTENDED ; Get another record ;**-1 100$: ; Symbol table entry. Just get program name MOV #RNM+RNMLEN-8.,%2 ; Point to area for name read CMPB @%2,#SPACE ; Do we have one already? BNE REXTENDED ; Yes, don't get another ADD #3,%0 ; Point to name field CALL GETHX1 ; Get length MOVB %1,%1 ; Sign extend byte BEQ REXTENDED ; Null name, get another record CMP %1,#8. ; > 8 bytes? BLOS 110$ ; Yes, OK MOV #8.,%1 ; Greater, 8 is all we store 110$: MOVB (%0)+,(%2)+ ; Copy name from record SOB %1,110$ BR REXTENDED ; Ignore rest of it 200$: ; Trailer: INCB TRAILER ; Note we had one ADD #3.,R0 ; SKIP DATA TYPE AND CHECKSUM (ALREADY CHECKED) CALL GETHXV ; GET VARIABLE LENGTH HEX TRANSFER ADDRESS BCS 250$ ; CS: ERROR MOV R1,R3 ; RETURN TRANSFER ADDRESS IN R3/R4 MOV R2,R4 RETURN 250$: JMP ERROR ; Error exit (abnormal) .PAGE .SBTTL CHECK - CHECK FOR VALID EXTENDED TEKHEX FORMAT CHECK: JSR %5,.SAVR1 ; Save registers %1-%5 CLR R4 ; ZERO R4 FOR CHECK SUM ACCUMULATION MOV R0,R5 ; SAVE START ADDR OF STRING MOVB (R0)+,R1 ; START CHECKING RECORD BEQ LENERR ; INVALID LENGTH ? GET OUT CALL CKSUM ; START CHECK SUM MOVB (R0)+,R1 ; GET NEXT CHAR BEQ LENERR ; INVALID LENGTH ? GET OUT CALL CKSUM ; VALIDATE & ADJUST CHECK SUM MOVB (R0)+,R1 ; CHECK OUT BLOCK TYPE BEQ LENERR ; NULL BYTE ? INVALID LENGTH CALL CKSUM ; VALIDATE & ADJUST CHECK SUM CALL GETHX2 ; OBTAIN CHECK SUM VALUE BCS ERRSET ; IF ERROR, GET OUT MOVB R1,R3 ; SAVE GIVEN CHECK SUM IN R3 5$: MOVB (R0)+,R1 ; VALIDATE THE REST OF RECORD BEQ FINISH ; END OF LINE ? FINISH UP CALL CKSUM ; VALIDATE & ADJUST CHECK SUM BR 5$ ; PROCESS THE NEXT BYTE FINISH: CMPB R3,R4 ; CHECK SUM RIGHT ? BNE CKSERR ; CHECK SUM ERROR ? GET OUT DEC R0 ; ADJUST POINTER BACK TO NULL SUB R5,R0 ; OBTAIN ACTUAL LENGTH OF STRING MOV R0,R3 ; SAVE LENGTH IN R3 MOV R5,R0 ; PUT START ADDR BACK IN R0 CLR R1 ; BLOCK LENGTH IS A WORD VALUE CALL GETHX2 ; GET BLOCK LENGTH FROM STRING BCS ERRSET MOVB R1,BLKLEN ; SAVE BLOCK LENGTH FOR POSTERITY BCS ERRSET ; LENGTH ERROR ? GET OUT CMPB R1,R3 ; VALIDATE LENGTH BEQ QUIT ; OK, return LENERR: JMP BCERROR ; INCORRECT BLOCK COUNT CKSERR: JMP CSERROR ; CHECK SUM ERROR ERRSET: JMP ERROR ; Hex conversion error QUIT: RETURN ; Return (only if) all OK, co-routine pops regs CKSUM: CMPB #'0,R1 ; COMPARE LOW BYTE OF R1 WITH '0' BGT SPCLOW ; CHECK TO SEE IF BYTE IS A '$','%','.', OR '_' SUB #'0,R1 ; COMMENCE TO CONVERTING CMPB #9.,R1 ; CHECK RANGE 0. THRU 9. BGE OK ; GOOD TEK HEX CHARACTER SUB #7.,R1 ; TAKE A SECOND CONVERSION STEP CMPB #10.,R1 ; CHECK FOR 'A' (UPPER CASE) BGT BAD ; NOT VALID TEK HEX CMPB #35.,R1 ; CHECK FOR 'Z' (UPPER CASE) BGE OK ; VALID BETWEEN 'A' AND 'Z' SUB #2.,R1 ; ADJUST FOR LOWER CASE CMPB #40.,R1 ; CHECK FOR 'a' (LOWER CASE) BGT SPCHI ; CHECK FOR '_' (UNDERLINE) CMPB #65.,R1 ; CHECK FOR 'z' (LOWER CASE) BGE OK ; VALID BETWEEN 'a' THRU 'z' (LOWER CASE) BR BAD ; NOT VALID TEK HEX SPCLOW: CMPB #'$,R1 ; CHECK FOR '$' BEQ OK ; $ IS VALID TEK HEX CMPB #'%,R1 ; CHECK FOR '%' BEQ OK ; % IF VALID TEK HEX SUB #8.,R1 ; ADJUST TO CHECK '.' (PERIOD) CMPB #38.,R1 ; CHECK FOR '.' BEQ OK ; '.' IS VALID TEK HEX BR BAD ; NOT VALID TEK HEX SPCHI: INC R1 ; ADJUST TO CHECK '_' CMPB #39.,R1 ; CHECK FOR '_' (UNDERSCORE) BEQ OK ; '_' IS VALID TEK HEX BAD: OUTPUT BET ; BAD CHAR IN EXTENDED TEK HEX JMP ERROR ; GET OUT OK: ADD R1,R4 ; ADD TO CHECK SUM RETURN .PAGE .SBTTL READ TEXAS FORMAT FILE ; tddddtddddtdddd... ; where: ; t = record type ("tag character"): ; 0 = program name (0aaaannnnnnnn) ; 1 = start address ; 7 = checksum, -(sum of ASCII chars since last csum) ; 9 = load address ; B = data ; F = end of record (no dddd) ; : = end of file ; others are defined, but not supported by HEX ; dddd = address or data, always a full word. RTEXAS: CLR -(SP) ; Clear start address CLR %3 ; Clear load address CLR %4 1$: CALL GETREC ; Get a record 220$ ; Don't worry if ':' trailer missing CLRB RECORD(R1) ; Make ASCIZ CLR CSUM ; Clear checksum 30$: MOVB (R0)+,%2 ; Get tag character, null = end of record BEQ 1$ ; EQ: yes - get another CMPB %2,#'F ; 'F' is end of record too BEQ 1$ CMPB %2,#': ; Colon found? BEQ 220$ ; Yes, end of file ADD %2,CSUM ; Add tag character to checksum CALL GETHX4 ; All other items have address/data -- get it to %1 BCC 40$ ; Make sure it worked JMP ERROR ; Else error 40$: CMPB %2,#'7 ; Checksum fetch? BNE 50$ ; No, branch ADD %1,CSUM ; Yes, sum + value read should give 0 BEQ 30$ ; Go get next item if it does JMP CSERROR ; Else checksum error ; All other types require ASCII char codes to be added to checksum. 50$: MOV #4,%5 ; Load a byte count SUB %5,%0 ; Step back over address 60$: CLR -(SP) ; Clear hi byte of @SP MOVB (%0)+,@SP ; Get a digit to lo ADD (SP)+,CSUM ; Add it to checksum SOB %5,60$ ; Repeat until 0 CMPB %2,#'0 ; 0 is program name specification BEQ 80$ ; Go process it CMPB %2,#'B ; B = data? BNE 70$ ; No, branch CALL STHCMP ; Store/compare hi CALL STHCMP ; Then lo BR 30$ ; Go back for next item 70$: CMPB %2,#'9 ; 9 = load address? BNE 90$ ; No, only 1 is left CALL DPADR ; Yes, copy address + ADDVAL to %3/%4 BR 30$ ; and get next item ; 0 is program name, 8 ASCII chars. 80$: MOV #8.,%2 ; Load counter MOV #RNM+RNMLEN-8.,%1 ; Load name pointer 85$: CLR -(SP) ; Get a character MOVB (%0)+,@SP ; as a word on the stack ADD @SP,CSUM ; Add it to checksum, MOVB (SP)+,(%1)+ ; store it and purge stack SOB %2,85$ ; Repeat for 8 chars BR 30$ ; and get another item 90$: CMPB %2,#'1 ; Only thing left is start address BEQ 100$ ; OK if that's it JMP ITERROR ; Else illegal block type 100$: MOV %1,@SP ; Store start address for exit BR 30$ ; Go get another item 220$: ; Trailer record INCB TRAILER ; Note we had one POP %1 ; Fetch SA from stack CALLR DPADR ; Add ADDVAL and return .PAGE .SBTTL MOSTEK FORMAT ; Four record types: ; F0rrrrssnn...nnaaiimmllllhhhhcc (module header) ; rrrr is record length ss...cc ; ss is length of module name (0-100) ; nn...nn hex-encoded ASCII program name ; aa address size, 16- or 32-bits ; ii processor ID (ignored) ; mm module type, 0 or 2 = no xfer addr, 1 or 3 = xfer addr ; llll lowest address in module (ignored) ; hhhh highest address in module (ignored). ; cc checksum, s.t. rr+rr+...+cc = 0. ; ; F2rrrraa...aadddd...ddcc (enumerated data) ; aa...aa 32- or 16-bit load address ; dd...dd data bytes ; ; F4rrrraa...aabbbb...bbcc (iterated data) ; bb...bb replicated data blocks ; This block type is not currently supported. ; ; F6rrrraa...aacc (end record) ; aa...aa is transfer address ; Equates for Mostek record types: MSHEAD = '0 ; MODULE HEADER RECORD MSENUM = '2 ; ENUMERATED DATA RECORD MSITER = '4 ; ITERATED HEADER RECORD MSTERM = '6 ; MODULE END RECORD RMOSTEK: CALL GETNOT ; Get a record, EOF is "no trailer" CLRB RECORD(%1) ; Make it ASCIZ 1$: TSTB (R0) ; END OF RECORD? BEQ RMOSTEK ; EQ: YES - GET ANOTHER RECORD CMPB #'F,(R0)+ ; "F" FOUND? BNE 1$ ; NE: NO, KEEP LOOKING CALL CHECKM ; VERIFY MOSTEK CHECKSUM CMPB #MSHEAD,(R0) ; IS THIS A MOSTEK HEADER RECORD? BEQ 10$ ; EQ: YES, PROCESS A MOSTEK HEADER RECORD CMPB #MSENUM,(R0) ; IS THIS AN ENUMERATED DATA RECORD? BEQ 20$ ; EQ: YES, PROCESS AN ENUMERATED RECORD CMPB #MSITER,(R0) ; IS THIS AN ITERATED DATA RECORD? BEQ 100$ ; EQ: YES, PROCESS AN ITERATED RECORD CMPB #MSTERM,(R0) ; IS THIS A TRAILER RECORD? BEQ 200$ ; EQ: PROCESS TRAILER RECORD JMP ITERROR ; "INVALID BLOCK TYPE" 10$: ; PROCESS MOSTEK HEADER RECORD ADD #5,R0 ; SKIP TYPE AND BLOCK LENGTH CALL GETHX2 ; GET RECORD LENGTH (# OF BYTES) IN R1 BCS 250$ MOVB %1,-(SP) ; Push as counter BEQ 13$ ; Nothing to do if zero length MOV #RNM+RNMLEN-8.,%2 ; Address record name storage 11$: CALL GETHX2 ; Fetch a name byte BCS 250$ CMP %2,#RNM+RNMLEN ; Room to store it? BHIS 12$ ; Don't store if we have 8 already MOVB %1,(%2)+ ; Else put in new name area 12$: DECB @SP ; Repeat for whole of name BNE 11$ 13$: POP ; Purge stack CALL GETHX2 ; GET ADDRESS SIZE BCS 250$ MOV R1,MOSTYP ; STORE ADDRESS MODE CMP #16.,R1 ; IS IT 16-BIT? BEQ 15$ ; EQ: O.K. CMP #32.,R1 ; IS IT 32-BIT? BEQ 15$ ; EQ: O.K. OUTPUT IAS ; "Invalid address size" BR 250$ ; TAKE ERROR EXIT 15$: CALL GETHX4 ; GET PROCESSOR TYPE (WHO CARES?) ; AND MODULE TYPE BCS 250$ ; CS: HEX CONVERSION ERROR ROR R1 ; IS TRAILER RECORD ON THIS MODULE? BCS RMOSTEK ; CS: YES INCB PART ; FORCE PARTIAL READ BR RMOSTEK ; Get next record 20$: ; PROCESS ENUMERATED RECORD CALL 210$ ; Get address and data count TST R5 ; ANY MORE PAIRS TO PROCESS? BEQ RMOSTEK ; EQ: NONE LEFT THIS RECORD 40$: CALL GETHX2 ; GET THE DATA BYTE BCS 250$ ; CS: TAKE ERROR EXIT CALL STOCMP ; Store or compare SOB R5,40$ ; DECREMENT NUMBER OF PAIRS TO READ BR RMOSTEK ; ALL DONE THIS RECORD 100$: ; Process iterated record CALL 210$ ; Get address CALL 1000$ ; Process iterated data block (recursively) BR RMOSTEK ; Go get another record 200$: ; Trailer -- get transfer address INCB TRAILER ; Note we had one 210$: ; Also gen purpose get address routine MOV BLKLEN,%5 ; Keep length of block in %5 CLR %1 ; Clear address lo CLR %2 ; and hi CMP %5,#1 ; If block length is 1 BLE 207$ ; Have checksum only (trailer blk w/o xfer addr) ADD #5,R0 ; SKIP REC TYPE AND REC LENGTH CMP #16.,MOSTYP ; 16-BIT MODE? BEQ 202$ ; EQ: YES - GET 4 HEX DIGITS CMP #32.,MOSTYP ; 32-BIT MODE? BEQ 204$ ; EQ: YES - GET 8 HEX DIGITS 249$: OUTPUT HRR ; "Header record required" 250$: JMP ERROR ; TAKE ERROR EXIT 202$: CALL GETHX4 ; GET 4 DIGIT TRANSFER ADDRESS BCS 250$ BR 206$ 204$: CALL GETHX8 ; GET 8 DIGIT TRANSFER ADDRESS BCS 250$ SUB #2,R5 ; ADJUST BLOCK LENGTH FOR LATER COMPUTATION 206$: SUB #2,R5 ; Compute data count by adjusting block length 207$: DEC %5 ; by address and checksum count MOV R1,R3 ; RETURN ADDRESS IN R3/R4 MOV R2,R4 CALLR ADDADV ; Add in ADDVAL and return ; Get iterated data record, recursively if necessary. Iterated block format is: ; mmmmbbccc... ; where ; mmmm is repeat count ; bb = no of embedded blocks, 0 if none ; ccc... is another iterated block if bb <> 0, else: ; nndd...dd ; where ; nn is byte count of dd...dd data pairs 1000$: PUSH %5 ; Save outer repeat count CALL GETHX4 ; Get repeat count for this block BCS 250$ MOV %1,%5 ; Copy repeat count CALL GETHX2 ; Get inner block flag BCS 250$ TSTB %1 ; Any more? BEQ 1020$ ; No, this is the last 1010$: PUSH %0 ; Yes, save where we are CALL 1000$ ; Call self for inner one(s) POP %0 ; Restore pointer SOB %5,1010$ ; Repeat mmmm times BR 1040$ ; and exit 1020$: CALL GETHX2 ; Final inner block, get byte count BCS 250$ CLR %5 ; to %5 BISB %1,%5 ; w/o sign extend 1030$: CALL GETHX2 ; Get data byte BCS 250$ CALL STOCMP ; Store or compare SOB %5,1030$ ; Repeat until done 1040$: POP %5 ; When restore outer count RETURN ; and return to caller (or self) .PAGE .SBTTL CHECKM - CHECK MOSTEK RECORD CHECKSUM CHECKM: PUSH %0 ; SAVE R0-R2 PUSH %1 PUSH %2 DEC R0 ; POINT BACK AT FIRST CHARACTER CLR CSUM ; Clear checksum CALL GETBYT ; Get record type into it CALL GETWRD ; GET RECORD LENGTH MOV R1,BLKLEN ; SAVE BLOCK LENGTH FOR LATER CALCULATIONS MOV R1,R2 ; HOW MANY "BYTES" LEFT THIS RECORD? BEQ 40$ ; EQ: THAT'S A BLOCK LENGTH ERROR 10$: CALL GETBYT ; Get the next data pair to CSUM SOB R2,10$ ; CONTINUE FOR ALL DATA BYTES 20$: .IIF NDF M$$EIS, TSTB CSUM ; CHECKSUM SHOULD NOW BE 00 BEQ 30$ ; EQ: CHECKSUM IS O.K. JMP CSERROR ; "Checksum error" 30$: TSTB (R0) ; WE SHOULD NOW BE AT THE END OF THE RECORD BEQ 255$ ; EQ: WE ARE 40$: JMP BCERROR ; "Invalid block count" 255$: POP %2 ; Restore %2-%0 POP %1 POP %0 RETURN ; RESTORE REGS .PAGE .SBTTL READ PDP-8/IM6100 OBJECT FILES ; File consists of binary records of byte pairs in the form: ; tthhhhhh 00llllll ; where: ; tt is the record type: 10 = leader (ignored) ; 01 = hhhhhhllllll is address ; 00 = hhhhhhllllll is data ; ; Two actual types are supported in the same READ module: ; RIM ("Read In Mode") is the simple (bootstrap) loader format, ; where address and data bytes alternate. ; BIN does not require addresses to be specified where data are ; contiguous. ; HEX differentiates bewteen the two types only for WRITE. ; 12-bit data bytes are stored with the hi 4 bits in the first 8-bit byte, ; and the lo 8 bits in the second. Thus the HEX address increments by 2 for ; each PDP-8 12-bit word, and is twice the value given in the file (including ; ADDVAL). RRIM: RBIN: CLR SAVLEN ; Clear length to force a read CLR %1 ; Default load address is ADDVAL 10$: CALL DPADR ASL %3 ; Addresses are always twice ROL %4 ; value given 1$: CALL 200$ ; Get a 12-bit value BCS 10$ ; Carry set is address, clear is data CALL STHCMP ; Store or compare hi byte CALL STHCMP ; Repeat for lo BR 1$ ; Go get next thing 90$: CALL GETEND ; Get a record; EOF is end, no transfer address 100$: DEC SAVLEN ; Else see if a byte to fetch BMI 90$ ; No, get another record MOVB (%0)+,%1 ; Fetch byte BMI 100$ ; Bit 8 set is leader/trailer, get another RETURN ; Else return with it ; Get a word to %1. Return with carry clear if data, set if address. 200$: CALL 100$ ; Get hi byte PUSH %1 ; to stack CALL 100$ ; Get lo BIT #^B11000000,%1 ; Bits 6 (& 7) must be clear BEQ 210$ JMP HCERROR ; Conversion error if not 210$: SWAB @SP ; Swap stack bytes ASR @SP ; Shift right twice ASR @SP ; (clears carry, since lo byte is 0) BIS (SP)+,%1 ; Form 12-bit value BIT #^B1000000000000,%1 ; If bit 13 is clear BEQ 220$ ; This is data SEC ; Else set carry to flag address 220$: BIC #^B1111000000000000,%1 ; Clear bits 12-15 anyway RETURN .PAGE .SBTTL WHITESMITHS' V2.1 LINKER FORMAT (XEQ. FILE) ; File consists of single-byte, fixed-length records, as: ; ; byte 1: ident byte, always 99H ; byte 2: configuration byte: ; bits 0-2: (no of chars in symbol table field)/2 - 1 ; bit3: 0 = ints are 2 bytes, 1 = ints are 4 bytes ; bit4: 0 = ints stored msb first, 1 = lsb first ; bits 5-6: storage bound restriction control bits ; bit 7: 0 = relocation information supplied, 1 = not supp ; bytes 3-4: size of symbol table ; Next 6 entries are 2 or 4 byte ints according to setting of bit3 of byte 2: ; int 1: number of text (program code) bytes ; int 2: number of data bytes ; int 3: no of bss bytes (uninitialised data) ; int 4: size of stack+heap ; int 5: text area start address ; int 6: data area start address ; This is followed by four contiguous segments of lengths controlled by the above: ; segment 1: text area ; segment 2: data area ; segment 3: symbol table ; segment 4: relocation information ; ; HEX only reads the text and data areas, and assumes that all relocation has ; already been done by the Whitesmiths' linker. Whitesmiths' object files, ; which have the same format, may thus be read, but relocation will not have ; been done. ; ; CAUTION: Whitesmiths set the file record size to 1, but write to every byte ; in the file, whereas since FCS forces fixed length records to start at even ; addresses, it only reads every other byte in these circumstances. Since we ; are in locate mode, it is quite possible to read the gaps in the same way, ; but this may not work on later releases of RSX-11M (OK for V4.0). See also ; WRITE. RWHITESMITHS: CALL GETNOT ; Get first byte pair CMPB (%0)+,#231 ; 99H? BEQ 10$ ; Yes, OK JMP ITERROR ; No, not a Whitesmith's format file 10$: MOVB @%0,CONFIG ; OK, get configuration byte CALL GETNOT ; Skip symbol table size (2 bytes) CALL 200$ ; Get text area size MOV %0,%2 ; Save hi in %2 MOV %1,%5 ; and lo in %5 CALL 200$ ; Data area size PUSH %1 ; Save for later PUSH %0 CALL 200$ ; Skip bss CALL 200$ ; and stack+heap sizes CALL 200$ ; Get text start address MOV %1,%3 ; To %3 (lo) MOV %0,%4 ; and %4 (hi) CALL 200$ ; Then data start address PUSH %1 ; Save that for later PUSH %0 CALL 50$ ; Read text POP %4 ; Get data area start address POP %3 POP %2 ; and byte count hi POP %5 ; and lo ; CALLR 50$ ; Load data and return 50$: ; Read %2/%5 bytes to area addressed by %3/%4 PUSH %2 ; Save count hi BIS %5,%2 ; Make sure there is something to do BEQ 70$ ; Exit if not CALL ADDADV ; Add ADDVAL to address 60$: BIT #1,%0 ; OK, get a byte. If %0 is at an odd address, BNE 65$ ; read it from the inter-record gap(!) CALL GETNOT ; Else get a new record 65$: MOVB (%0)+,%1 ; Copy byte to %1 CALL STOCMP ; Store/compare SOB %5,60$ ; Repeat for count bytes DEC @SP ; in double-precision BPL 60$ CLR %3 ; No start address CLR %4 70$: POP ; Purge stack of count hi RETURN ; Read an int value in no of bytes and order defined in configuration byte, ; CONFIG. Return value in %0(hi), and %1(lo). 200$: CALL 300$ ; Get first two bytes CLR %0 ; Clear %0 BIT #^B1000,CONFIG ; in case 16-bits only BEQ 220$ ; Return if so PUSH %1 ; Else 2 more bytes to come. Save first 2 CALL 300$ ; Fetch next two ; Now have a long int in @SP (1st 2 bytes read), and both %0 and %1 (second 2). ; If CONFIG bit 4 is clear, 1st two read go into hi=%0, lo=%1 is second 2. ; If CONFIG bit 4 is set, 1st two read go into lo=%1, second two into hi=%0 ; right from 300$, but word order must be reversed if CONFIG bit 4 is set. BIT #^B10000,CONFIG ; Which byte first? BEQ 210$ ; Clear = msb, just pop 1st pair to %0 MOV %1,%0 ; Set = lsb, copy hi just read POP %1 ; Fetch lo read first BR 220$ ; and return 210$: POP %0 ; Get high word to %0 220$: RETURN ; Get a 2-byte short int to %1, in byte order according to CONFIG. 300$: CALL GETNOT ; Get a byte pair MOV (%0)+,%1 ; to %1 BIT #^B10000,CONFIG ; Storing lsb first? BNE 310$ ; Yes if bit set, same as PDP-11 SWAB %1 ; No, swap bytes first 310$: RETURN .PAGE .SBTTL HEX-CHAR AND OCTAL-CHAR FORMATS ; ^B ; $Abbbb, ; aaaa-ddxddxddx...ddx ; aaaa-ddxddxddx...ddx ; ^C ; $Sssss, ; where: ; ctrl/B marks start of data ; bbbb is load address for Data I/O programmer ; aaaa is alternative load address (see below) ; dd is data ; s is separator, in SEPTOR, usually space, ', or % ; ctrl/C marks end of data ; ssss is checksum = dd+dd+... ; ; Formally, bbbb is the true address, and aaaa's should be ignored. However, to ; cater for early Data I/O programmers which can't relocate, aaaa- may be ; included to override bbbb. (If x is a hyphen, use aaaa= instead). ; ; The no of digits in the data items is not fixed -- only the last byte before ; the separator is significant, and anything else intervening is ignored. .ENABL LSB RHEX: MOV #HEXDGT,DGTSUB ; Load hex digit test routine addr BR 5$ ; Join common code with octal ROCTAL: MOV #OCTDGT,DGTSUB ; Load routine to test for octal digit ; Look for ^B, defining start of data. 5$: CLR %1 ; Default store address is 0 CALL DPADR ; + ADDVAL CLR CSUM ; Clear checksum MOVB #'-!200,ADREND ; Address at start of line will end '-' CMPB SEPTOR,#'- ; Unless that's the data separator BNE 10$ MOVB #'=!200,ADREND ; When use '=' instead ; Look for start of data, end of file, or checksum ($Saaaa,) for data just ; read in (if any). 10$: CALL GETEND ; Get a record; end of file is trailer record CLRB RECORD(R1) ; Make ASCIZ 20$: TSTB @%0 ; End of record? BEQ 10$ ; Yes, get another CMPB @%0,#'B&37 ; Control-B? BNE 30$ ; No, try checksum CLR CSUM ; Yes, clear new sum BR 140$ ; for data items following ; Only other acceptable thing after a trailer is checksum, as $Saaaa. 30$: MOV #'S,%1 ; Check for '$S' CALL 300$ BCS 20$ ; Ignore anything else SUB %1,CSUM ; Checksum OK? Reset to 0 if so BEQ 20$ ; Yes, go look for another block JMP CSERROR ; No, checksum error ; Data read section. Get and store bytes, checking terminator:- ; ctrl/C means end of data block ; SEPTOR means preceding thing was a data item, ; ADREND means preceding number was an address, ; $A means following number is an address, terminated by comma. 130$: CALL GETNOT ; Get a record, shouldn't end without trailer now BICB #200,ADREND ; Allow recognition of special address flag CLRB RECORD(R1) ; Make ASCIZ BR 142$ ; Check first byte 140$: BISB #200,ADREND ; Don't recognise address in middle of line 141$: INC %0 ; Bypass number terminator 142$: TSTB @%0 ; End of record? BEQ 130$ ; Yes, get another CALL 400$ ; Fetch {number} and terminator CMPB @%0,SEPTOR ; Data item? BNE 150$ ; No, branch BIC #^C377,%1 ; Yes, get lo byte only ADD %1,CSUM ; Add to checksum CALL STOCMP ; Load/compare data BR 140$ ; Go get more 150$: CMPB @%0,ADREND ; New address? BEQ 160$ ; Yes, go set it CMPB @%0,#'C&37 ; No, ^C? BEQ 10$ ; Yes, trailer MOV #'A,%1 ; Only other thing is 'A' CALL 300$ BCS 142$ ; No, ignore as comment 160$: CALL DPADR ; New address, load it to %3/%4 ADD %2,%4 ; including hi word BR 140$ ; Get next thing ; Check for control record: $xaaaa, where x is in %1. ; Ignore if x is not expected character, else fetch aaaa, making sure it ; ends with a comma. Return cc if value fetched, cs if not expected $x. 300$: CMPB (%0)+,#'$ ; Dollar? BNE 310$ ; No, skip character CMPB (%0)+,%1 ; Yes, check letter -- A or S BNE 310$ ; Ignore any other combination CALL 400$ ; Get address or checksum CMPB @%0,#', ; Should have ended on comma BNE 320$ ; Error if not TST (PC)+ ; Clear carry, skipping SEC 310$: SEC ; Come here to set carry if not expected characters RETURN ; Return 320$: JMP HCERROR ; Else invalid number format ; Get a number of any number of digits, until terminator, addressed by %0 ; on exit. Result to %1 (lo) and %2 (hi). ; Routine address in DGTSUB checks and adjusts for hex or octal digit. 400$: CLR %1 ; Clear result CLR %2 PUSH %3 ; Save %3 410$: MOVB @%0,%3 ; Get character SUB #'0,%3 ; Digit? BMI 420$ ; Not if < '0' CALL @DGTSUB ; Check for hex or octal as required BCS 420$ ; Done if not a digit .REPT 3 ; Shift up result so far ASL %1 ROL %2 .ENDR BIS %3,%1 ; OR in binary value INC %0 ; Point to next character BR 410$ ; Try that 420$: POP %3 ; Restore %3 RETURN ; Exit with value ; Hex digit test HEXDGT: CMP %3,#9. ; Or > '9' BLE 500$ ; Otherwise it is, go add CMP %3,#'A-'0 ; 'A'? BLT 520$ ; No, found terminator CMP %3,#'F-'0 ; to 'F'? BGT 520$ ; No, terminator SUB #'A-10.-'0,%3 ; Yes, convert digit to binary 500$: ASL %1 ; Do one shift now, ROL %2 ; 3 more done by caller 510$: CLC ; Say OK RETURN ; return ; Octal digit test OCTDGT: CMP %3,#7 ; > '7' BLE 510$ ; No, OK 520$: SEC ; Yes, not a digit RETURN .DSABL LSB .IF DF TCI .PAGE .SBTTL TCI FORMAT ; ; @aaaadddd...dd ; where: ; aaaa = address ; dd...dd is data bytes RTCI: CALL GETEND ; Get a record; end of file is trailer record MOV R1,R5 ; SAVE LRECL CLRB RECORD(R1) ; MAKE ASCIZ 30$: TSTB (R0) ; END OF RECORD? BEQ RTCI ; EQ: YES - GET ANOTHER DEC R5 ; DECREMENT LRECL CMPB #'@,(R0)+ ; @ FOUND? BNE 30$ ; NO - KEEP LOOKING SUB #4,R5 ; COMPUTE DATA COUNT ASR R5 ; NUMBER OF BYTES LEFT /2 CALL GETWRD ; GET ADDRESS CALL DPADR ; CURRENT ADDRESS GOES IN R3/R4 40$: ; PROCESS A DATA BYTE CALL GETBYT ; GET THE DATA BYTE CALL STOCMP ; Store or compare SOB R5,40$ ; CONTINUE FOR DATA COUNT BR RTCI ; PROCESS ANOTHER RECORD .ENDC ; TCI format support .PAGE .SBTTL SIRA BINARY FORMAT ; 1aatbbdddd...ddc ; where (bytes): ; aa = address -- lo/hi ; t = type: 0=data, 1=EOF, 2=autostart ; bb = byte count -- lo/hi ; dd...dd = data bytes ; c = checksum, a+a+t+b+b+d+...d RSIRA: CLR SAVLEN ; Say no data, so first BINBYT will fetch it ; Look for an 001 byte, signifying start of record. 10$: CALL BINBYT ; Get byte DEC %1 ; Is it 1? BNE 10$ ; No, keep looking CLR CSUM ; Found start, don't include in checksum JSR PC,BINWRD ; Next word = store address CALL DPADR ; Copy address + ADDVAL JSR PC,BINBYT ; Get next byte = block type MOV %1,%5 ; Save JSR PC,BINWRD ; While reading byte count TSTB %5 ; Test type BNE 50$ ; Branch if EOF block MOV %1,%5 ; Else this is a program block, save count BEQ 30$ ; Trap dummy null record ; Read and store the %5 bytes in the record, where %3/%4 points. 20$: JSR PC,BINBYT ; Read byte JSR PC,STOCMP ; Store byte, advancing memory pointer SOB %5,20$ ; Decrement count and repeat until all done ; Make sure checksum is right. 30$: CALL BINCSM ; Fetch and test checksum BEQ 10$ ; Get another record if OK 40$: JMP CSERROR ; Else binary checksum error ; End-of-file block. If type (%5) = 2, have autostart. In any case, start ; address (or 0) is in %2. 50$: INCB TRAILER ; Note we had a trailer TST %1 ; Byte count should be 0 BEQ 60$ ; OK if so JMP BCERROR ; "Invalid block count" if not 60$: CMP %5,#2 ; Type =1 or 2? BLOS 70$ ; Yes, just check checksum JMP ITERROR ; No, say "Invalid block type" 70$: CALL BINCSM ; Final byte is checksum BNE 40$ ; Else error RETURN ; OK if so .PAGE .SBTTL MACRO-11 ABSOLUTE BINARY FORMAT ; Assemble MACRO source with .ENABL ABS, or /EN:ABS. ; ; aadd... ; where: ; aa = load/start address ; d... = data bytes .ENABL LSB ; Read and store the %5 bytes in the record, where %3/%4 points. 10$: MOVB (%0)+,%1 ; Get next byte CALL STOCMP ; Store byte, advancing memory pointer SOB %5,10$ ; Decrement count and repeat until all done ; BR OBJECT ; Get another record ROBJECT: CLR SAVLEN ; Clear record length, to force a read CALL BINWRD ; Get store/start address CALL DPADR ; Copy to address MOV SAVLEN,%5 ; See how many bytes left BNE 10$ ; Get data unless address is all there was INCB TRAILER ; Note we had a trailer ASR %1 ; See if address (w/o ADDVAL) is odd BCC 20$ ; Yes, %3/%4 is transfer address CLR %3 ; No, clear %3/%4 to signify none CLR %4 20$: RETURN .DSABL LSB .PAGE .SBTTL DEC PAPER-TAPE ABSOLUTE LOADER FORMAT ; This is the format used by the PDP-11 paper-tape absolute (not bootstrap) ; loader: ; ; 10bbaaddd...dc ; ; 10 indicates start of data ; bb is byte count from 1 to last data byte, lo+hi ; aa is address lo+hi ; dd...d is data bytes ; c is checksum such that 1+0+b+b+a+a+d+...+d+c = 0 ; ; an end block is defined by bb=6, i.e. a block without data, when aa is the ; start address, or none if aa is odd. RABSOLUTE: CLR SAVLEN ; Say no data, so first BINBYT will fetch it ; Look for an 001 byte, signifying start of record. 10$: CALL BINBYT ; Get byte MOV %1,CSUM ; (Re-)set checksum DEC %1 ; Is it 1? BNE 10$ ; No, keep looking CALL BINBYT ; Next byte should be null TSTB %1 BEQ 15$ ; OK if so JMP ITERROR ; Else "Invalid block type" 15$: JSR PC,BINWRD ; Get byte count MOV %1,%5 ; to %5 JSR PC,BINWRD ; Next word = store address CALL DPADR ; Copy address + ADDVAL SUB #6,%5 ; Subtract header count from total BLE 50$ ; -ve is EOF block ; Read and store the %5 bytes in the record, where %3/%4 points. 20$: JSR PC,BINBYT ; Read byte JSR PC,STOCMP ; Store byte, advancing memory pointer SOB %5,20$ ; Decrement count and repeat until all done ; Make sure checksum is right. 30$: CALL BINBYT ; Fetch and test checksum BEQ 10$ ; Get another record if OK 40$: JMP CSERROR ; Else binary checksum error ; End-of-file block. If address (%1 and %3/%4) is odd, no transfer addr, else it ; is given in %3/%4. 50$: INCB TRAILER ; Note we had a trailer ASR %1 ; See if address (w/o ADDVAL) is odd BCC 60$ ; Yes, %3/%4 is transfer address CLR %3 ; No, clear %3/%4 to signify none CLR %4 60$: CALL BINBYT ; Final byte is checksum BNE 40$ ; Error if sum not zero RETURN ; OK if it is .PAGE .SBTTL TASK FILE FORMAT ; ; Programs should be built with TKB (NOT FTB) as follows: ; ; prog.SYS/-HD/-MM/-FP/-SE,map=prog,... ; / ; STACK=ssssss ; UNITS=0 ; ACTFIL=0 ; ASG=0 ; PAR=:lo addr:size ; {TASK=name} ; // ; ; where: ; lo addr is the lowest memory area to be loaded. Must be in octal, and ; a multiple of 100(8). ; size must be a value big enough to contain the given code. A larger ; value than needed may be given; any extra space is not used ; (or zeroed). size must also be a multiple of 100(8). ; ssssss (which nominally sets the stack size) actually sets the breakpoint ; between relocatable PSECTs (above ssssss) and the .ASECT area, ; (below it) otherwise you get overwrite error messages (even if ; you don't have any relocatable code!). Its value should be ; computed as: ; ssssss=(highest absolute address-lo addr)/2 ; words, and entered in decimal. ; ; The resulting task image takes the form of two "label" blocks, followed by the ; task itself, starting in block 3 with data for lo addr onwards. The following ; entries of the first label block only are used:- ; ; L$BTSK (0-3) task name, radix-50 ; L$BSA (10) lo addr ; L$BHGV (12) hi addr ; L$BXFR (350) start address ; L$BHRB (356) offset to task data block from this block .MCALL LBLDF$ LBLDF$ ; Define task header block offsets .PSECT READ,I,RO ; Reset PSECT RTASK: CALL GETREC ; Read first label block IOERROR ; Not even EOF allowed MOV %0,%5 ; Copy buffer pointer MOV #RNM+RNMLEN-8.,%0 ; Buffer for program name MOV (%5)+,%1 ; which is in first 2 words of 1st block JSR PC,$C5TA ; in Radix-50 MOV (%5)+,%1 ; 6 ASCII bytes JSR PC,$C5TA ; (leave last 2 spaces, as preset) PUSH L$BXFR-4(%5) ; Save transfer address MOV L$BSA-4(%5),%1 ; Get lo load address CALL DPADR ; to %3/%4 PUSH L$BHGV-4(%5) ; Get hi-lo+1 SUB %1,@SP ; Giving no of bytes in file ADD #2,@SP ; + 1 for pre-decrement MOV L$BHRB-4(%5),%5 ; Get no of remaining header blocks before data 40$: CALL GETREC IOERROR SOB %5,40$ ; and ignore them ; Read data straight from file blocks. 45$: MOV %1,%5 ; Load block size (512.) 50$: DEC @SP ; Reached last address? BEQ 100$ ; Done if so MOVB (%0)+,%1 ; Else fetch a byte CALL STOCMP ; Store or compare SOB %5,50$ ; Repeat while some to do INC %5 ; Read 1 BR 40$ ; new block 100$: POP ; Purge count from stack MOV @SP,%1 ; Fetch transfer address ROR (SP)+ ; Is it odd? BCS 110$ CALLR DPADR ; No, include ADDVAL and return 110$: JMP NOXFER ; Odd transfer address means none given .SBTTL READ DATA AREAS .PSECT DATA RW,D ATTDET: QIOW$ IO.ATT,TILUN,TILUN ; Attach/detach for ^O during COMPARE ADDVAL: .BLKL ; USER SUPPLIED OFFSET TO BE ADDED TO ADDRESS ; UPON READING SAVLEN: .BLKW ; SAVED LENGTH OF INPUT RECORD IN CASE OF ERROR DCOUNT: .BLKW ; Number of differing bytes found on compare ;**-2 CSUM: .BLKW ; TEMPORARY SCRATCHPAD WHILE COMPUTING CHECKSUM RETSP: .BLKW ; SP->return address for error exits from anywhere CMPFLG: .BLKB ; COMPARE/READ FLAG 0->COMPARE, 1-> READ PART: .BLKB ; 0 --> FULL FILE, 1 --> NO TRAILER RECORD TRAILER:.BLKB ; 0 --> TRAILER RECORD NOT SEEN IN THIS FILE ; NZ -> TRAILER RECORD ENCOUNTERED ERRFLG: .BLKB ; Error flag .IIF DF P$$OFF,WRNFLG: .BLKB ; Warning flag DEFM AMF DEFM DCT <0000 differences> .EVEN ; Remaining scratch area is used in different ways by different read processors, ; all overlaid. COMMON: ; Extended TekHex: BLKLEN: .BLKW 1 ; LENGTH OF BLOCK, NOT INCLUDING LEADING ; % OR END OF LINE TERMINATOR .=COMMON ; Rockwell: RECCNT: .BLKL ; No of records read .=COMMON ; Hex/octal: DGTSUB: .BLKW ; Digit check routine, OCTDGT or HEXDGT ADREND: .BLKB 1 ; Address flag for HEX/OCTAL format .=COMMON ; Mostek: .BLKW 1 ; NUMBER OF DATA BYTES (also called BLKLEN) MOSTYP: .BLKB 1 ; TYPE, 0 --> NO HEADER READ YET, ; 16 --> 16-BIT ADDRESS MODE, ; 32 --> 32-BIT ADDRESS MODE. .=COMMON ; Whitesmiths': CONFIG: .BLKB 1 ; Configuration byte .PSECT PURE RO,D ; Format processor lookup table. N.B.B. The order MUST match the definitions ; in HEX, and equivalent tables in FORMAT and WRITE. Bit 0 set means this is ; a binary format, so record shouldn't be displayed on error. FORMTS: .WORD RINTEL ; 0 .WORD RMOTOROLA ; 2 .WORD RROCKWELL ; 4 .WORD RRCA ; 6 .WORD RTEKHEX ; 10 .WORD REXTENDED ; 12 .WORD RTEXAS ; 14 .WORD RMOSTEK ; 16 .WORD RWHITESMITHS!1 ; 20 .WORD RRIM!1 ; 22 .WORD RBIN!1 ; 24 .WORD RHEX ; 26 .WORD ROCTAL ; 30 .WORD RTCI ; 32 .WORD RSIRA!1 ; 34 .WORD ROBJECT!1 ; 36 .WORD RABSOLUTE!1 ; 40 .WORD RTASK!1 ; 42 DEFM HRR
DEFM IAS DEFM IBC DEFM IBT DEFM TRL DEFM CSE DEFM TRI .EVEN .END