;ISIS2 05/21/81 ;XYBASIC Interpreter Source Module ;Copyright (C) 1978, 1979, 1980, 1981 by Mark Williams Company, Chicago ;statement routines for ISIS-II version SAVE and LOAD, plus GTFIL if isis2 ;ISIS-II versions if rtpak ;UF error in Runtime Module version save equ uferr load equ uferr else ;^B exit to ISIS-II if debug boot equ 0 ;^B gets MDS monitor rather than ISIS-II else boot: mvi c,exitf lxi d,exblk call isis ;return to ISIS endif ;SAVE save: call prntm ;print SAVING message db 'SAVING', ' ' or 80H mvi a,2 ;set A for writing call gtfil ;get file name and open it shld wrblk ;set aft of write block jnc savea ;ASCII save ora a jnz saveh ;HEX save if romsq lhld sourc else lxi h,srcad endif shld wrblk+2 ;set starting address = srcad if romsq push d call last pop d else lhld eofad ;eof addr to HL endif dad d ;length of file to HL shld wrblk+4 ;set count for write call isisw ;write the file isisc: mvi c,dkclf ;close the file and return lxi d,clblk isise: call isis lda estat ora a ;check error status rz ;no error mvi c,erri2 lxi d,estat call isis ;issue ISIS error, fall through to DKERR dkerr: error f, D, K ;fatal DK error ;ASCII SAVE savea: lda omode push psw ;save output mode mvi a,80H sta omode ;80H to OMODE to indicate ASCII save call save0 ;initialize file block lxi b,-1 call list1 ;list the program to disk file mvi c,cntlz call dwrit ;followed by eof pop psw sta omode ;restore omode value jmp isisc ;close the file and return ;SAVE0 initializes WRBLK to write 1 char from TEMP2, ;returns first program loc in HL. save0: lxi h,temp2 shld wrblk+2 ;file chars passed in temp2 lxi h,1 shld wrblk+4 ;set count = 1 char per call if romsq lhld sourc else lxi h,srcad endif ret ;HEX SAVE saveh: xchg ;-first to HL shld temp ;and saved call save0 ;initialize WRBLK push h ;save first if romsq ;last address to HL call last else lhld eofad endif xchg ;last to DE pop h ;first to HL dcx h ;first - 1 ;convert the file to hex and write it savh1: push h ;save current lxi b,10H ;max record length to BC dad b ;current + max to HL call cmdhu ;compare eof to current + max pop h ;restore current mov a,c ;max to A jnc savh2 ;eof >= current + max, write max mov a,e sub l inr a ;eof+1 - current = remaining to be written jz savh4 ;current = eof+1, just write eof record savh2: push d ;save eof address mov e,a ;length to E mvi d,0 ;checksum to D mvi c,':' call dwrit ;write record mark mov a,e call wbyte ;write length call waddr ;write address and record type savh3: mov a,m ;fetch data byte inx h call wbyte ;write data dcr e jnz savh3 ;write more data call wcsum ;write the checksum pop d ;restore eof address jmp savh1 ;and do more ;write eof record savh4: mvi c,':' call dwrit ;write : xra a mov d,a ;checksum to D call wbyte ;write record length = 0 if romsq lhld sourc dcx h else lxi h,srcad-1 endif call waddr ;write starting address 0 and record type call wcsum ;write the checksum mvi c,cntlz call dwrit ;write eof jmp isisc ;close file and return ;LOAD load: if romsq call issrc ;must be addressing working space endif call prntm ;print LOADING message db 'LOADING', ' ' or 80H mvi a,1 ;set A for reading call gtfil ;get file name, open it shld rdblk ;set aft of read param block jnc loada ;ASCII load ora a jnz loadh ;HEX load lxi h,srcad shld rdblk+2 ;set starting address = srcad lhld memt dad d ;max possible program length to HL shld rdblk+4 ;and then to read block call new ;clobber old program call isisr ;read the file call isisc ;close the file lxi d,srcad-1 ;first addr - 1 to DE lhld temp ;actual count to HL dad d ;compute eof address load1: mov a,m ora a jz dmodx ;all is well load2: call new ;else erase the bad prog jmp dkerr ;and issue DK error isisr: mvi c,dkrdf lxi d,rdblk jmp isise ;ASCII load loada: call load0 ;set RDBLK and clobber old program lda omode push psw ;save OMODE mvi a,7FH sta omode ;set OMODE for ASCII load loda1: call gtlin ;get a line call tkize ;tokenize it jc loda1 ;ignore if no line # cnz addln ;add to source jmp loda1 ;and keep loading ;LOAD0 initializes RDBLK to read 1 char to TEMP2. load0: lxi h,temp2 shld rdblk+2 lxi h,1 shld rdblk+4 jmp new ;HEX load loadh: call load0 ;initialize RDBLK and clobber old program lodh1: call dread ;read a char from hex file sui ':' jnz lodh1 ;not record mark, retry mov d,a ;0 for checksum to D call rbyte ;read a file byte jz lodh3 ;eof record mov e,a ;else record length to E call rbyte ;read destination msb push psw ;and save call rbyte ;read destination lsb pop h ;destination msb to H mov l,a ;destination now in HL lxi b,srcad-1 ;base address to BC dad b ;add to base address for actual destination call rbyte ;skip type byte lodh2: call rbyte ;read a data byte mov m,a ;and store inx h ;address next dcr e jnz lodh2 ;load another data byte call rbyte ;read checksum jnz loadx ;checksum error dcx h ;point to last loaded byte shld eofad ;and reset EOFAD in case end of program jmp lodh1 ;load next record lodh3: call isisc ;close the file lhld eofad ;point to end of file jmp load1 loadx: call isisc ;close the file after error jmp load2 ;erase bad program, issue DK error ;The ISIS-II version of GTFIL gets a file name and opens the file. ;The filename is [:device:]"" [, {A | H} ] . ;Call: A 1 to read, 2 to write ; HL address of message to print (SAVING or LOADING) ;Retn: Carry Reset iff ASCII specified (with ,A) ; A 0 for .XYB, 1 for .HEX ; DE - first address of source + 1 ; HL aft of opened file devf0: db ':F0:', 80H ;default device name to copy basft: db '.BAS ', 80H ;file type to copy xybft: db '.XYB ', 80H ;file type to copy hexft: db '.HEX ', 80H ;file type to copy gtfil: sta opblk+4 ;set access mode of open parameter block mvi d,':' call gtd ;look for device name lxi d,fname ;file name addr to DE jc gtfl0 ;no device name, take default call gtchd ;store :, read 1st char call gtchd ;store 1st, read 2nd char call gtchd ;store 2nd, read : cpi ':' jnz snerr ;no : call gtchd ;store :, read " gtfl1: cpi '"' jnz snerr ;no " call gtild ;get first filename char jc snerr ;not letter or digit, SN error mvi b,5 ;max # chars in filename is 6 gtfl2: stax d ;store filename char inx d call writc ;echo the char gtfl3: call gtild ;get next filename char jc gtfl4 ;no more filename chars dcr b jp gtfl2 ;store and get next jmp gtfl3 ;too long, skip storing gtfl4: push d ;save next fname addr call wcrlf ;write cr and lf mvi d,'"' call gtdsn ;skip close quote call gtcom ;look for comma lxi d,xybft ;XYB filetype addr to DE mvi a,0 ;0 to A in case .XYB cnc gtfl5 ;use other filetype instead if comma pop h ;next fname addr to HL push psw ;save carry status call cpyst ;copy file type to FNAME mvi c,dkopf lxi d,opblk call isise ;open the file if romsq lhld sourc dcx h ;address preceding source to HL xchg ;and then to DE else lxi d,srcad-1 ;address preceding source to DE endif call cplde ;- first address + 1 lhld aft ;aft to HL pop psw ;restore carry status ret gtfl5: mvi d,'A' call gtd ;look for A lxi d,basft rnc ;gotcha, return Carry reset mvi d,'H' call gtdsn ;SN error if neither H nor A lxi d,hexft mvi a,1 stc ;return Carry, A = 1 if HEX ret gtfl0: xchg ;FNAME addr to HL lxi d,devf0 ;default device name addr to DE call cpyst ;copy :F0: to FNAME dcx h ;HL points to next FNAME loc available xchg ;DE points to next call gtcha ;get next char jmp gtfl1 ;and continue as above gtchd: stax d inx d jmp gtcha ;routines for disk i/o ;DKOUT writes a character from C to the open disk file dkout: lxi h,temp2 mov m,c ;character to temp2 for writing isisw: mvi c,dkwrf lxi d,wrblk jmp isise ;write the char and return ;DLOAD reads char from disk for ASCII LOAD dload: call drea1 ;read char jnz pop3 ;return unless eof call isisc ;close the file lxi sp,stack-4 ;omode and nexts return pushed pop psw sta omode ;restore omode jmp dmod2 ;and return to direct mode ;DREAD reads char for HEX LOAD dread: push3 call drea1 jnz pop3 jmp loadx ;eof read ;DREA1 is called from DLOAD and DREAD to read a disk char. ;Retn: A char read ; BCDEHL clobbered ; Zero set iff eof drea1: call isisr ;read char to TEMP2 lda temp ;fetch actual count ora a rz ;actual = 0, i.e. eof lda temp2 ;else fetch char read ani 7FH ;remove parity bit cpi cntlz ;Zero set iff eof ret ;routines for HEX LOADing and SAVEing ;INTEL HEX format is a series of records, with all info in ASCII: ;frame 0 record mark ':' [3AH] ;frames 1-2 record length n, hex number 0-FFH [0 for eof; here max=10H] ;frames 3-6 load address ;frames 7-8 record type [here 0] ;frames 9 - 8+2*n data ;frames 9+2*n - 10+2*n checksum [negated sum mod 256 of preceding items] ;WASCI converts A3-A0 to ASCII and falls through to DWRIT to write wasci: ani 0FH ;00H, ..., 09H, 0AH, ..., 0FH adi 90H ;90H, ..., 99H, 9AH, ..., 9FH daa ;90H, ..., 99H, 00H+C,...,05H+C aci 40H ;D0H, ..., D9H, 41H, ..., 46H daa ;30H, ..., 39H, 41H, ..., 46H mov c,a ;pass value to write through C ;and fall through to DWRIT dwrit: push4 call dkout ;write the char jmp pop4 ;WBYTE writes byte from A as two ASCII bytes, updating checksum in D wbyte: push psw rrc rrc rrc rrc call wasci ;convert left nibble to ascii and write pop psw push psw call wasci ;convert right nibble to ascii and write pop psw add d mov d,a ;update checksum ret ;WADDR writes address from HL (subtracting loading bias), and record type. waddr: push h push d xchg ;address to DE lhld temp ;-first to HL dad d ;load address to HL pop d mov a,h call wbyte ;write high byte mov a,l call wbyte ;write low byte xra a call wbyte ;write record type = 0 pop h ret ;and return ;WCSUM writes the checksum from D, followed by CR and LF. wcsum: xra a sub d call wbyte ;write checksum mvi c,cr call dwrit mvi c,lf jmp dwrit ;write cr and lf and return ;RBYTE reads two ASCII bytes and builds binary char, updating checksum in D. ;Retn: A char read ; C clobbered ; D updated checksum ; BEHL preserved ; Zero set iff new checksum = 0 rbyte: call dread ;read a byte call ishex ;convert ASCII to binary jc loadx ;not an ASCII hex digit, abort rlc rlc rlc rlc mov c,a ;high nibble to C call dread ;read another call ishex jc loadx ;not ASCII hex digit ora c ;form complete byte from nibbles mov c,a ;and save add d ;update checksum mov d,a ;and checksum to D mov a,c ;restore result to A ret endif ;end of NOT RTPAK conditional endif ;end of ISIS2 conditional ;end of ISIS2 page