! EDIT = 06027B 17:15 "REPOSITION (UPDATED 101678)" ICOM 4000 IASSEMBLE Tape driver ! LIST,XREF RE-SAVE "TREADS" LOAD "MAKE" END ISOURCE ! *********************** ISOURCE NAM Tape_driver ISOURCE EXT Relocate !This external subroutine is used ISOURCE !when the binary is loaded ISOURCE SPC 2 ISOURCE ! B A S E P A G E E Q U A T E S ISOURCE R34: EQU A+34B !block register upper instruction ISOURCE R35: EQU A+35B !block register lower data ISOURCE Ares: EQU A+223B !address of result ISOURCE Exerb: EQU A+302B !execution error ISOURCE E13a: EQU A+307B !improper delimiter ISOURCE E14a: EQU A+310B !improper expression ISOURCE Epara: EQU A+315B !expression followed by ! or EOL ISOURCE Demaa: EQU Q+321B !expression parser demands delimin B ISOURCE Apgn3: EQU A+331B !cop routine for block N to block 3 ISOURCE Exlsa: EQU A+335B !list routine ISOURCE Aexel: EQU A+412B ! ISOURCE Xpxa: EQU A+435B !expression executer ISOURCE Aasn: EQU A+534B !expression assignment ISOURCE Cupta: EQU A+661B !get atribute & current len of symbol ISOURCE Iwana: EQU A+727B !return integer ISOURCE Tapdir15: EQU A+172230B !Taco directory copy ISOURCE B3utl: EQU A+177244B ! ISOURCE Ioflg: EQU A+177402B !flag for value or address of var ISOURCE Snflg: EQU A+177403B !flag for string, num or string or num ISOURCE Vrflg: EQU A+177423B !flag returned for var or not var ISOURCE SPC 2 ISOURCE DAT 2 !9835 ISOURCE DAT T9825nam !ascii name of binary ISOURCE BSS 1 !releative link to next binary ISOURCE DAT Treadh !key word pointer ISOURCE DAT =-1 !no secondry keywords ISOURCE JMP Lpu !lpu attention routine ISOURCE DAT 0 !jmp to ppu stolen rom routine/rom init ISOURCE DAT 0 !jmp to ppu poweron routine/rom init after sys init ISOURCE DAT 0 !mas memory driver link ISOURCE DAT * !DEF * ISOURCE DAT *+4 !DEF * ISOURCE DAT 2 !number of words to be relocated ISOURCE Reloc: DAT Relocate ! ISOURCE Jmptable: DAT Jmptbl ISOURCE DAT 0,0 !end of this binary ISOURCE SPC 2 ISOURCE T9825nam: DAT "TREAD " !name of this binary ISOURCE DAT "101678" !date code ISOURCE ! L P U A T T E N T I O N R O U T I N E ISOURCE Lpu: LDA C ISOURCE ADA Jmptable ISOURCE JMP A,I ISOURCE SPC 2 ISOURCE Jmbtbl: JMP Poweron !C=0 ISOURCE JMP Reset !C=1 ISOURCE JMP Load !C=2 LOAD BIN ISOURCE JMP Loadall !C=3 ISOURCE JMP Scratch !C=4 ISOURCE JMP MpreRun !C=5 MAIN PROGRAM PRERUN ISOURCE JMP SpreRun !C=6 SUBPROGRAM PRERUN ISOURCE JMP EnterSub !C=7 save vars before entering subprogram ISOURCE JMP Exitsub !C=8 restore vars after subprogram ISOURCE SPC 1 ISOURCE Poweron: RET 1 ! ISOURCE Reset: RET 1 ! ISOURCE Load: JMP Reloc,I ! relocat progrom upon loading ISOURCE Loadall: RET 1 ! ISOURCE Scratch: RET 1 ! ISOURCE Mprerun: RET 1 ! ISOURCE Sprerun: RET 1 ! ISOURCE Entersub: RET 1 ! ISOURCE Exitsub: RET 1 ! ISOURCE Tapdir15a: DAT Tapdir15 ! ISOURCE SPC 2 ! (line 0770) ISOURCE ! S Y N T A X F O R T R E A D S T A T M E N T ISOURCE ! SYNTAX: TREAD , , , ISOURCE ! ISOURCE ! Expression one is the track number ISOURCE ! Expression two is the file number ISOURCE ! Expression three is the sting buffer that will ISOURCE ! receive the data read from the 9825 tape. ISOURCE ! Expression four is the file type variable ISOURCE ! Expression five is the completion or error code ISOURCE ! returned from the statement TREAD. ISOURCE ! All expressions are required. Expression one ISOURCE ! must be 0 or 1, expression two can not be ISOURCE ! negative, expression three must be a string ISOURCE ! variable (simple or subscripted) and expression ISOURCE ! four and five must be a variable (used to ISOURCE ! return the file type and a completion value). ISOURCE Syntax: LDB =1 !demand a comma as delimeter (line 940) ISOURCE JSM Demaa,I !accept (exp) followed by comma ISOURCE JMP E13a,I !improper delimeter ISOURCE LDB =1 !demand a comma as a delim ISOURCE JSM Demaa,I !accpet (exp) followed by comma ISOURCE JMP E13a,I !improper delimeter ISOURCE LDA =-1 !string exp expected ISOURCE STA Snflg ! ISOURCE LDA =1 !var exp expected ISOURCE STA Ioflg ! ISOURCE LDB =1 !demand a comma delim ISOURCE JSM Demaa,I !accept (exp) followed by comma ISOURCE JMP E13a,I !improper delimeter ISOURCE LDA Vrflg !third exp must be var ISOURCE SZA Var_exp !error var expected ISOURCE LDA =1 !num exp expected ISOURCE STA Snflg ! ISOURCE STA Ioflg !var exp expected ISOURCE LDB =1 !demand a comma as delim ISOURCE JSM Demaa,I !accept (exp) followed by comma ISOURCE JMP E13a,I !improper delimeter ISOURCE LDA Vrflg !fourth exp must be var ISOURCE SZA Var_exp !error var expected ISOURCE JSM Epara,I !accept fifth and last exp ISOURCE JMP E13a,I !improper delimeter ISOURCE LDA Vrflg !fifth exp must be var ISOURCE SZA Var_exp !error var expected ISOURCE RET 1 ! ISOURCE SPC 1 ! ISOURCE Var_exp: JMP E14a,I !improrer expresion ISOURCE SPC 2 ISOURCE ! K E Y W O R D H E A D E R ISOURCE Treadh: DAT ==1 !no additional key words ISOURCE DAT "TREAD " !name of this key word ISOURCE DAT 10000B+2048+Tread-Treadh-1 ISOURCE JMP Syntax !syntax routine ISOURCE JMP Exlsa,I !list routine ISOURCE ! T R E A D R O U T I N E ISOURCE Tread: LDA R35 ISOURCE STA R35temp ISOURCE JSM Expex1 !evaluate first expression ISOURCE RET 1 ISOURCE JSM Iwana,I !get integer track number ISOURCE RET 1 ISOURCE SZB Trk_ok !check value of track for 0 or 1 ISOURCE CPB =1 ISOURCE JMP Trk_ok ISOURCE LDA=19 !improper value ISOURCE JMP Exerb,I ISOURCE Trk_ok: STB Track_num !save track number ISOURCE JSM Expex1 !evaluate second expression ISOURCE RET 1 ISOURCE JSM Iwana,I !get integer file number ISOURCE RET 1 ISOURCE SBP File_ok !check file numbe for non zero ISOURCE LDA=19 !improper value ISOURCE JMP Exerb,I ISOURCE File_ok: STB File_num !save file number to read ISOURCE JSM Expex1 !evaluate third expression ISOURCE RET 1 ISOURCE LDA Ares !save temp area ISOURCE LDB =String_ptr ISOURCE XFR 5 ISOURCE JSB Expex1 !get address of fourth expression ISOURCE RET 1 ISOURCE LDA Ares !save temp area ISOURCE LDB =File_ptr ISOURCE XFR 5 ISOURCE JSB Expex1 !get address of fifth expression ISOURCE RET 1 ISOURCE LDA Ares !save temp area ISOURCE LDB =Error_ptr ISOURCE XFR 5 ISOURCE SPC 3 ISOURCE ! I N I T I A L I Z A T I O N F O R T A P E I N T E R R U P T ISOURCE LDA =0 !clear the 9835 tape directory ISOURCE STA Tapdir15a,I ISOURCE LDB String_ptr+3 !symbol table offset ISOURCE JSM Cupta,I !get information about the string ISOURCE ADB =1 ISOURCE LDA B,I !get max number of characters ISOURCE STA Dim_len ISOURCE LDA String_ptr !get offset desited ISOURCE RAR 2 ISOURCE AND =77777B ISOURCE STA Actual_offset ISOURCE RLA *+2 !force offset even ISOURCE ADA =1 !to word boundary ISOURCE ADA =1 ISOURCE STA Offset ISOURCE LDB Dim_len !check ifstring offset is ok ISOURCE TCA ISOURCE ADA B ISOURCE SAP Len_ok ISOURCE LDA =18 !substring out of range ISOURCE JMP Exerb,I ISOURCE Len_ok: LDA String_ptr+1 !pointer to current length ISOURCE LDB String_ptr+4 !block number of buffer ISOURCE STB R35 ISOURCE LDB Actual_offset !check for offset reyond current ISOURCE ADB =-1 !length of string by more than one ISOURCE TCB ISOURCE ADB A,I ISOURCE SBP Current_ok ISOURCE SZB Current_ok ISOURCE LDA =18 !substring out of range ISOURCE JMP Exerb,I ISOURCE Current_ok: LDB Offset !(line 2010) ISOURCE SBR 1 ISOURCE ADA B ISOURCE STA Xtemp ISOURCE SPC 2 ISOURCE LDA R34 !get the current block number ISOURCE STA A+175727B !store block num in ext int table ISOURCE LDA Tape_int_a ISOURCE STA A+175747B !store as interrupt address ISOURCE SIM ISOURCE LDA A+177017B !get the old tape interrupt vector ISOURCE STA Save_tape_vtr !save that vector for restore ISOURCE LDA Hlopa !get address of cop routine ISOURCE STA A_177017B !store cop routine in tape ISOURCE CIM !interrupt vecotr location ISOURCE LDB =15 !load B with %15 ISOURCE STB Pa !store in perperal register ISOURCE ! ISOURCE ! A C T I V A T E T A P E D R I V E R ISOURCE ! ISOURCE JSM Clear_status !clear tape status ISOURCE ! C L E A R S T A P E S T A T U S ISOURCE LDA =0 !initialze valid flag ISOURCE STA Valid_flag ! ISOURCE LDA Req_int !verify interrupt (015000B) ISOURCE JSM Int_set_up !go do it ISOURCE ! S E T T R A C K N U M ISOURCE LDA Track_num !get the track number ISOURCE SAL 6 ISOURCE ADA Set_track !form track command (014000B) ISOURCE STA 5 !select the track ISOURCE ! P O S T I O N T H E T A P E A T F I L E ISOURCE LDA File_num !if file num is zero ISOURCE RZA No_wind !then rewind the tape ISOURCE Rewind_ok: LDA =4 !set valid flag ISOURCE STA Valid_flag ISOURCE JSM Rewind !go rewind the tape ISOURCE LDA =-2000 !forward two inches ISOURCE STA R6 ISOURCE SFC *+0 ISOURCE LDA For_tac_int !verify interrupt (174000B) ISOURCE JSM Int_set_up !go do it ISOURCE ! P O S I T I O N I N R I G H T G A P ISOURCE LDA File_num ISOURCE JMP After_wind ISOURCE No_wind: LDA =0 ISOURCE After_wind: CMA ISOURCE STA R6 ISOURCE SFC *+0 ISOURCE LDA Int_n_gap !verify interrupt (160200B) ISOURCE JSM Int_set_up ISOURCE CPA =8 !check for hole detect ISOURCE JMP Tape_end ISOURCE LDA Stop_n_int !hole interrupt (111000B) ISOURCE JSM Int_set_up ISOURCE CPA =8 !check for hole detect ISOURCE JMP Tape_end ISOURCE LDA R6 ISOURCE ADA Tac_num ! (-500) ISOURCE SAM Tape_driv3 !if netagive then within gap ISOURCE TCA !take twos complement ISOURCE STA R6 ISOURCE SFC *+0 ISOURCE LDA Rev_tac_int !backup up (030000B) ISOURCE JSM Int_set_up ISOURCE Tap_driv3: LDA Threshold !load threshold (003035B) ISOURCE STA R7 ISOURCE SFC *+0 ISOURCE LDA Read_t_comm !read tape command (173000B) ISOURCE LDB =-7 !length of the header ISOURCE STM Read_count !(line 2710) ISOURCE LDB R7 !purge checksum ISOURCE LDB =1 ! ISOURCE JSM Int_set_up2 !interrupt setup and read ISOURCE ! T H E F I L E ISOURCE LDB Stop_comm !stop command (010000B) ISOURCE STB R5 ! ISOURCE LDA Int_status !check for postition werror ISOURCE CPA =8 !check for hole detect ISOURCE JMP Tape_end ! ISOURCE LDB Valid_flag !check valid flag (000000B) ISOURCE CPB =4 ! ISOURCE JMP Tape_end !too late to try reposition ISOURCE CPA =4 ! ISOURCE JMP Repos_now ! ISOURCE CPA =9 !check for null file ISOURCE JMP Tape_end ! ISOURCE CPA =10 !check for secured file ISOURCE JMP Tape_end ! ISOURCE LDB Int_comm ! ISOURCE CPB =3 !check for error in header ISOURCE JMP *+2 ! ISOURCE JMP Tape_end !elsewhere ISOURCE JMP Rewind_ok ISOURCE Repos_now: LDA No_of_file !if file num is zero ISOURCE RZA Repos_ok ISOURCE JMP Rewind_ok ISOURCE Repos_ok: ISZ Valid_flag !update the valid flag ISOURCE JMP Reposition ISOURCE JMP Tape_end !problem ISOURCE JMP Tape_driv3 !normal ISOURCE Tape_end: LDA Stop_comm !stop command (010000B) ISOURCE STA R5 ISOURCE LDA Save_tape_vtr !get the former interrupt vector ISOURCE SIM !block num as in interrupt ISOURCE STA A+177017B !restore tape interrupt vector ISOURCE CIM ! ISOURCE LDA File_count !get the input file length ISOURCE LDB Int_status ISOURCE CPB =5 !check for error condition ISOURCE JMP Read_ok ISOURCE CPB =6 ISOURCE JMP Read_ok ISOURCE JMP Error_len ISOURCE Read_ok: SAL 1 !shift left to make byte count ISOURCE ADA Offset !create actual len of string var ISOURCE ADA =-2 !offset starts at one byte not zero ISOURCE LDB String_ptr+4 ISOURCE STB R35 ISOURCE LDB String_ptr+1 ISOURCE STA B,I !length into actual string ISOURCE Error_len: LDA File_type !return to basic the file type ISOURCE LDB Int_status ISOURCE CPB =5 !chekc for error ISOURCE JMP File_read_ok ISOURCE LDA =0 !set file type to zero ISOURCE File_read_ok: STA Source_temp+1 ISOURCE LDA =4 ISOURCE STA Source_temp ISOURCE LDA =File_ptr+100000B !pointer to temp ISOURCE STA Dest_ptr ISOURCE LDA Aexel ISOURCE STA Delimiter !create an execution ISOURCE LDA Aasn !goes into ISOURCE STA Operator ISOURCE LDA =Operator ISOURCE STA C ISOURCE JSM Expex1 ISOURCE RET 1 !error return ISOURCE LDA Int_status !return to basic final status ISOURCE STA Source_temp+1 !save in temp ISOURCE LDA =4 ISOURCE STA Source_temp ISOURCE LDA =ERror_ptr+100000B !pointer to temp ISOURCE STA Dest+ptr ISOURCE LDA Aexel !create an execution ISOURCE STA Delimiter !goes into ISOURCE LDA Aasn ISOURCE STA Operator ISOURCE LDA =Operator ISOURCE STA C ISOURCE JSM Expex1 ISOURCE RET 1 !error return ISOURCE RET 2 !end of statement ISOURCE !*************************** ISOURCE SPC 2 ISOURCE Expex1: LDA Xpxa !evaluate expression ISOURCE STA B3utl ISOURCE JSB Apgn3,I !any block to block 3 ISOURCE RET 1 ISOURCE RET 2 ISOURCE ! C O N S T A N S T A N D V A R I A B L E S ISOURCE SPC 2 ISOURCE LIT20 ISOURCE File_ptr: BSS 5 ISOURCE Error_ptr: BSS 5 ISOURCE String_ptr: BSS 5 ISOURCE Operator: BSS 1 ISOURCE Dest_ptr: BSS 1 ISOURCE DAT Source_temp+100000B ISOURCE Delimiter: BSS 1 ISOURCE Source_temp: BSS 4 ISOURCE Dim_len: BSS 1 ISOURCE Offset: BSS 1 ISOURCE Actual_offset: BSS 1 ISOURCE R35temp: BSS 1 ISOURCE Xtemp: BSS 1 ISOURCE Hlopa: DAT 032702B ISOURCE File_num: BSS 1 ISOURCE Track_num: BSS 1 ISOURCE File_type: BSS 1 ISOURCE File_count: BSS 1 ISOURCE Valid_flag: BSS 1 ISOURCE Save_tape_var: BSS 1 ISOURCE Set_track: DAT 014000B ISOURCE Int_n_gap: DAT 160200B ISOURCE Threshold: DAT 003035B ISOURCE Read_t_comm: DAT 173000B ISOURCE Stop_comm: DAT 010000B ISOURCE Req_int: DAT 015000B ISOURCE Tape_int_a: DAT Tape_int ISOURCE Data_block_a: DAT Read_block ISOURCE Read_count_a: DAT Read_count ISOURCE For_tac_int: DAT 174000B ISOURCE Stop_n_int: DAT 111000B ISOURCE Rev_tac_int: DAT 030000B ISOURCE Tac_num: DAT -500 ISOURCE SPC 3 ! (line 3980) ISOURCE ! S U B R O U T I N E T O S E T U P T H E I N T E R R U P T ISOURCE ! L O O K F O R R E T U R N S T A T U S O F N O N Z E R O ISOURCE Int_set_up LDB =0 !load B with 0 for usual interrupt ISOURCE Int_set_up2 STB Int_comm_a,I !store as the interrupt command ISOURCE LDB =0 !load B with 0 ISOURCE STB Int_stat_a,I !store interrupt status ISOURCE STB Header_cnt,I ! ISOURCE LDB =Header_buf ISOURCE STB Data_pointer ISOURCE LDB R35temp ISOURCE STB Data_block ISOURCE STA R5 ISOURCE SPC 1 ISOURCE LDA Int_stat_a,I !set the interrupt status ISOURCE SZA *-1 !loop if interrupt status is 0 ISOURCE SPC 1 ISOURCE JSM Clear_Status !clear the status ISOURCE LDA Int_stat_a,I !get the interrupt status ISOURCE RET 1 ISOURCE LIT 2 !room for the literals ISOURCE Int_stat_a: DAT Int_status ISOURCE Int_comm_a: DAT Int_comm ISOURCE Header_cnt: DAT Header_buf+8 ISOURCE SPC 2 ISOURCE ! T A P E I N T E R R U P T S E R V I C E R O U T I N E ISOURCE Tap_int: LDB R35 ISOURCE STB Int_save_r35 ISOURCE LDB R5 ISOURCE RLB Hole_in_tape ISOURCE SBR 1 ISOURCE RLB Cart_out ISOURCE LDB Int_comm !get the interrupt command ISOURCE ADB Int_ptg ISOURCE LDB B,I ISOURCE JMP B,I ISOURCE SPC 2 ISOURCE ! C A R T R I D G E T A P E I S O U T O F T H E T R A N S P O R T ISOURCE Cart_out: LDA =2 ISOURCE STA Int_status !report error ISOURCE JMP Tape_int_ret ISOURCE SPC 2 ISOURCE ! H O L E D E T E C T E D I N T A P E ISOURCE Hole_in_tape: LDA =8 ISOURCE STA Int_status !report error ISOURCE JSM Clear_status ISOURCE LDA R4 ISOURCE JMP Tape_int_ret ISOURCE SPC 2 ISOURCE ! A N Y O T H E R C O M M A N D ISOURCE Any_other_int: JSM Clear_status ISOURCE LDA R4 ISOURCE ISZ Int_status !inc the int status ISOURCE JMP Tape_int_ret !return twice ISOURCE JMP Tape_int_ret !just to be sure ISOURCE SPC 2 ISOURCE Read_check: ISZ Int_comm ! ISOURCE LDA R4 !read the checksum word read from tape ISOURCE STA Check_read ISOURCE LDB R7 !read checksum computed ISOURCE STB Check_comp ISOURCE CPA B ISOURCE JMP Read_check1 !they compute ISOURCE LDA =3 !load with error 3 ISOURCE STA Int_status !store as status ISOURCE JMP Tape_int_ret !exit this interrupt ISOURCE Read_check1: LDB Int_comm !was this the checksum of a header ISOURCE CPB =6 ! ISOURCE JMP Header_check ISOURCE LDA Tac_int_const !skip over the partition gap (-8) ISOURCE STA R6 ISOURCE SFC * ISOURCE LDA Tac_int ! (174000B) ISOURCE STA R5 ISOURCE CPB =3 !check for file header ISOURCE JMP Chk_fl_no !then check file num ISOURCE JMP Tape_int_ret !exit this interrupt ISOURCE SPC 2 ISOURCE Chk_fl_no: LDA No_of_file ISOURCE CPA File_num ISOURCE JMP Chk_abs_sz ISOURCE LDA =4 !file num error ISOURCE STA Int_status ISOURCE JMP Tape_int_ret !they agree ISOURCE Chk_abs_sz: LDA Absolute_size !check absolute file size ISOURCE RZA Abs_size_ok !this is not a null file ISOURCE LDA =9 !inidcate error code 9 ISOURCE STA Int_status ! ISOURCE JMP Tape_int_ret ! ISOURCE Abs_size_ok: LDA Header_buf+5 !check for secured file ISOURCE CPA =0 ISOURCE JMP Tape_int_ret ISOURCE LDA =10 !indicate secured file error ISOURCE STA Int_status ISOURCE JMP Tape_int_ret ISOURCE SPC 2 ISOURCE Header_check: LDA Read1_comm !read command for body (173000B) ISOURCE STA R5 !for partition ISOURCE JMP Tape_int_ret ISOURCE SPC 2 ISOURCE Read_data: LDA R4 ISOURCE LDB Data_block ISOURCE STB R35 ISOURCE STA Data_pointer,I !store intro String_buf ISOURCE LDB Int_save_r35 ISOURCE STB R35 ISOURCE ISZ Data_pointer ISOURCE ISZ Read_count !done with this read ISOURCE JMP Tape_int_ret !not yet, exit this interrupt ISOURCE SPC 2 ISOURCE ! C O M P L E T E D R E A D O F O N E B L O C K ISOURCE ! command to read the checksum, then compute new block pointers ISOURCE ! if this is the file head, check for the type and ISOURCE ! number, then return if not correct ISOURCE LDA Checksum_comm !command taco to read checksum (177000B) ISOURCE STA R5 !output that checksum ISOURCE LDB Int_comm !for the header ISOURCE ISZ Int_comm !advance the interrupt vector netxt int ISOURCE CPB =1 !check for header just input ISOURCE JMP File_hdr ! ISOURCE JMP Tape_int_ret !exit this interrupt ISOURCE SPC 2 ISOURCE ! F I L E H E A D E R ISOURCE !File_hdr: LDA No_of_file !check file num ISOURCE ! CPA File_num ISOURCE ! JMP File_no_ok ISOURCE ! LDA =4 !tape file position error ISOURCE ! STA Int_status ISOURCE ! JMP Tape_int_ret !exit this interrupt ISOURCE File_hdr: NOP ISOURCE File_no_ok: LDA Len_file !get the length read(words) ISOURCE STA File_count !store as the file count ISOURCE SAL 1 !check for space in string ISOURCE ADA Offset !large enough for the file ISOURCE ADA =-2 !and if not flag with error 7 ISOURCE TCA ISOURCE ADA Dim_len ISOURCE SAP Enough_room ISOURCE LDA =7 ISOURCE STA Int_status ISOURCE JMP Tape_int_ret !exit this interrupt ISOURCE Enough_room: LDA Type_file !read the fyle type ISOURCE STA File_type ISOURCE LDA Xtemp !now set data pointer to point to ISOURCE STA Data_pointer !the stirng in the basic program ISOURCE LDA String_ptr+4 !also take care of the block num ISOURCE STA Data_block ISOURCE JMP Tape_int_ret !exit this interrupt ISOURCE SPC 2 ISOURCE Start_block: LDA R4 !dummy read to initiate ISOURCE LDB =4 ! initialize the interrupt vector ISOURCE STB Int_comm ISOURCE LDB =3 !length of the partition ISOURCE STB Partit_count ISOURCE LDA =Header_buf+7 !fix pointer to partition buffer ISOURCE STA Header_ptr ISOURCE LDA Len_file !get the file count ISOURCE LDB Partit_len !update the total count ISOURCE TCB ISOURCE ADA B ISOURCE RZA Next_part !skip if not zero ISOURCE LDA =5 !completion status ISOURCE STA Int_status !increment status done with file ISOURCE JMP Tape_int_ret !exit this interrupt ISOURCE Next_par: LDB Read1_comm !read 9825 command (173000B) ISOURCE STB R5 !sent to taco ISOURCE STA Len_file !update the file count ISOURCE Tape_int_ret: LDB Int_save_r35 !restore the block num ISOURCE STB R35 ISOURCE RET 1 !exit ISOURCE SPC 2 ISOURCE Partit_hdr: LDA R4 !get next word of the header ISOURCE LDB R5 !chekc for gap ISOURCE RBR 4 ISOURCE RLB Part_gap ISOURCE STA Header_ptr,I !save header info ISOURCE ISZ Header_prt ISOURCE DSZ Partit_count ISOURCE JMP Tape_int_ret !exit this interrupt ISOURCE ISZ Int_comm !advance interrupt vectore to next int ISOURCE LDB Partit_len !check for done ISOURCE SZB Last_hdr !yes, 0 length header ISOURCE TCB ISOURCE STB Read_count !save length of this partition ISOURCE LDA Checksum_comm !checksum command (177000B) ISOURCE STA R5 ! ISOURCE JMP Tape_int_ret !exit this interrupt ISOURCE SPC 2 ISOURCE Part_gap: JSM Clear_status !partiton gap ISOURCE LDB Read1_comm ! (173000B) ISOURCE STA R5 ISOURCE JMP Tape_int_ret !exit this interrupt ISOURCE SPC 2 ISOURCE Last_hdr: LDA =6 !completion status ISOURCE STA Int_status !absolute end of file ISOURCE RET 1 ISOURCE SPC 2 ISOURCE Preamble: LDA R4 !read preamble ISOURCE ISZ Int_comm !update for next interrupt ISOURCE LDA R7 !RESET THE CHECKSUM ISOURCE JMP Tape_int_ret !exit this interrupt ISOURCE SPC 2 ISOURCE ! C O N S T A N T S A N D V A R I A B L E S ISOURCE LIT 15 ISOURCE Int_ptg: DAT Int_vector ISOURCE Int_vector: DAT Any_other_int ! 0 - all other interrupts ISOURCE DAT Read_data ! 1 - header ISOURCE DAT Read_check ! 2 - header checksum ISOURCE DAT Start_block ! 3 - start block ISOURCE DAT Partit_hdr ! 4 - partition header ISOURCE DAT Read_check ! 5 - partition checksum ISOURCE DAT Preamble ! 6 - preamble ISOURCE DAT Read_data ! 7 - data ISOURCE DAT Read_check ! 8 - checksum ISOURCE DAT Start_block ! 9 - start block ISOURCE Tac_int: DAT 174000B ISOURCE Tac_int_const: DAT -8 ISOURCE Checksum_comm: DAT 177000B ISOURCE Readi_com: DAT 173000B ISOURCE Int_save_r35: BSS 1 ISOURCE Read_count: BSS 1 ISOURCE Partit_count: BSS 1 ISOURCE Int_comm: BSS 1 ISOURCE Int_status: BSS 1 ISOURCE Data_pointer: BSS 1 ISOURCE Data_block: BSS 1 ISOURCE Check_read: BSS 1 ISOURCE Check_comp: BSS 1 ISOURCE Header_buf: BSS 1 ISOURCE Header_ptr: BSS 1 ISOURCE Filenumber: DAT File_num ISOURCE No_of_file: EQU Header_buf ISOURCE Absolute_size: EQU Header_buf+1 ISOURCE Len_file: EQU Header_buf+2 ISOURCE Type_file: EQU Header_buf+3 ISOURCE Partit_len: EQU Header_buf+8 ISOURCE SPC 3 ISOURCE ! R E W I N D S U B R O U T I N E ISOURCE Rewind: LDA =-5000 !load A with -5000 ISOURCE STA R6 !store in R6 ISOURCE SFC *+0 !wait until flag is clear ISOURCE LDA Fast_tac_int !command to move forward, slow ISOURCE JSM Int_set_up !setup the in routine and do it ISOURCE ! R E V E R S E D I R E C T I O N U N T I L H O L E ISOURCE LDA Rewind_comm !load with rewind command (024200B) ISOURCE JSM Int_set_up !output rewind to taco ISOURCE LDA Move_slowr !now go forward slowly ISOURCE JSM Int_set_up !output move to taco ISOURCE RET 1 ISOURCE ! C O N S T A N T S A N D D A T A ISOURCE LIT 7 ISOURCE Fast_tac_int: DAT 171200B ISOURCE Rewind_comm: DAT 024200B ISOURCE Move_slowr: DAT 124000B ISOURCE SPC 3 ISOURCE Clear_status: SFC *+0 !wait until the flag is clear ISOURCE LDA R5 ! ISOURCE AND =100700B ISOURCE IOR Clear_comm !command to clear taco ISOURCE STA R5 !output thru R5 ISOURCE SFC *+0 !wait until it is accepted ISOURCE RET 1 ISOURCE Clear_comm: DAT 034000B ISOURCE SPC 3 ISOURCE ! R E P O S I T I O N R O U T I N E ISOURCE !this routine finds a new file based on the current tape ISOURCE !position (first word of String_buf) and the input file ISOURCE !number (in File_num) this routine asusmes that the program ISOURCE !just read the file head and is about to read the first ISOURCE !of the file ISOURCE Reposition: LDA No_of_file !get the current tape position ISOURCE TCA ! ISOURCE ADA File_num !add the desired file num ISOURCE SAP Postiton_fwd !diff positive, go forward ISOURCE ! G O B A C K ISOURCE ADA =-1 ISOURCE STA R6 !store diff in the tac ISOURCE SFC *+0 ISOURCE LDA Int_n_goback !go back n gaps interrupt ISOURCE JSM Int_set_up !setup the interrupt ISOURCE LDA Stop_n_int !stop and count tac's ISOURCE JSM Int_set_up !setup the interrupt ISOURCE LDA =-1 ISOURCE JMP X_fwd ISOURCE Position_fwd: CMA ISOURCE ADA =1 ISOURCE X_fwd: STA R6 !store as the number of gaps ISOURCE SFC *+0 ISOURCE LDA Int_n_gapfwd !interrupt on n gaps forward ISOURCE JSM Int_set_up !setup the interrupt ISOURCE CPA =8 !check for hole detect ISOURCE RET 1 ISOURCE LDA Stop_n_int ISOURCE JSM Int_set_up !setup the interrupt ISOURCE LDA R6 ISOURCE ADA Tac_num ISOURCE SAM Stop_ok ISOURCE TCA ISOURCE STA R6 ISOURCE SFC *+0 ISOURCE LDA Rev_tac_int ISOURCE JSM Int_set_up !setup the interrupt ISOURCE Stop_ok: Ret 2 ! (line 7000) ISOURCE ! Literals and Constants and Variables (line 7010) ISOURCE LIT 3 ! (link 7020) ISOURCE !Stringbuf_arp: DAT String_buf ISOURCE Int_n_gapback: DAT 060200B ISOURCE Rev_n_tac: DAT 030000B ISOURCE Int_n_gapfwd: DAT 160200B ISOURCE Move_fwd_slow: DAT 060464B ISOURCE SPC 2 ! (line 7080) ISOURCE END Tape_driver ! (line 7090) ISOURCE END ! (line 7100)