mdavis@pro-sol.UUCP (Morgan Davis) (07/26/87)
*=============================== -*- Mode: Merlin -*- * Executioner (EXEC file maker) * Glen E. Bredon Dec 24, 86 *------------------------------- DATE TR ADR TR EXP OFF SAVOBJ KBD * Data LINSTART = #"." ;This is the character at start of ;each line, but not checked for. ;This is simply to avoid the possibility ;of a DOS command at the beginning of a line. * Usage by this program: FPNT = $D0 ;Pointer to catalog entry LEN = $D2 ;For reading directory ENTPER = LEN+1 ; " THISCNT = $D4 ; " NL = $D5 ;PRDEC usage NH = $D6 ; " NFL = $D7 ; " BASFLAG = $D8 ;Flags basic program MAXLEN = $D9 ;Count for len of basic prog PFLAG = $DB ;Flags extra 6-bit packing ADD0 = $DC ;Used to compute expansion ADD1 = $DD ; factor at end ADD2 = $DE PNT = $E0 ;Pointer to code TEMP = $E2 ;For 6-bit unpacker only FLAG = $E3 ;Misc use ADRS = $E2 ;For line header TXTP = $E4 ;For SENDMSG CNT = $E6 ;Count up for len of code SLASHFLG = $E8 ;Disable slash on file name BUFPNT = $E9 ;Pointer into 1 pg wrt buf YSAV = $EA COUNT = $EB ;& C,D: size of EXEC file LINLEN = $EE ;# of bytes on each line PACKFLG = $EF ;+ if ord, V set if 6-bit THREE = $F0 ;Count (-) for three bytes XSAV = $F1 BYT0 = $F2 ;Temp storage when packing BYT1 = $F3 BYT2 = $F4 BYT3 = $F5 STARTFLG = $F6 ;Flags initial entry SIZ0 = $F7 ;Used to compute exp factor SIZ1 = $F8 CHKSUM = $FF ;Used only in packing modes LOADADR = $1000 ;Start adrs written to file FILEBUF = $1000 ;Buffer for our file write WBUF = $1800 ;1 page buffer for writing CATBUF = $1C00 ;1 block needed for this PROGBUF = $3000 ;Source file load adrs FILES = $8000 ;Catalog entry list * Apple stuff: CH = $24 CV = $25 IN = $200 DOSWARM = $3D0 RESET = $3F2 MLI = $BF00 DEVNUM = $BF30 BITMAP = $BF58 ALTCHRS = $C00F SPEAKER = $C030 TOKENS = $D0D0 ;Applesoft token table TABV = $FB5B CLREOP = $FC42 HOME = $FC58 WAIT = $FCA8 RDKEY = $FD0C GETLNZ = $FD67 CROUT = $FD8E PRBYTE = $FDDA COUT = $FDED MONITOR = $FF69 * MLI call codes: quit = $65 create = $C0 destroy = $C1 setinfo = $C3 getinfo = $C4 online = $C5 setpfx = $C6 getpfx = $C7 open = $C8 read = $CA write = $CB close = $CC seteof = $D0 geteof = $D1 *=============================== STADR MAC LDA #]1 STA ]2 LDA #>]1 STA ]2+1 <<< INCD MAC INC ]1 BNE NI INC ]1+1 NI <<< MOVD MAC LDA ]1 STA ]2 LDA ]1+1 STA ]2+1 <<< DOS MAC JSR MLI DFB ]1 DA ]2 <<< WRITE MAC LDX ]1 LDY #0 LUP INY LDA ]1,Y JSR WRTBYTE DEX BNE LUP <<< *=============================== TYP $FF ;Make SYS file ORG $2000 JMP START0 HEX EEEE ;STARTUP signature DFB $40 ;Its max length STARTUP DS $40 ;Prefix (etc) for dest file *------------------------------------ * File type names (followed by type). * Change the "NON" ones to add types. *------------------------------------ TYPES ASC "BAD"01 ASC "TXT"04 ASC "BIN"06 ASC "DIR"0F ASC "ADB"19 ASC "AWP"1A ASC "ASP"1B ASC "S16"B3 ASC "NDA"B8 ASC "CDA"B9 ASC "TOL"BA ASC "DOC"BF ASC "PNT"C0 ASC "PIC"C1 ASC "FON"C8 ASC "CMD"F0 ASC "LNK"F8 ASC "BAS"FC ASC "VAR"FD ASC "REL"FE ASC "SYS"FF LUP 11 ASC "NON"00 --^ TYPEND ERR *-TYPES/$84 START0 LSR STARTFLG ;Signal initial entry START STADR EXIT ;RESET ;Set up RESET vector EOR #$A5 STA RESET+2 LDX #$17 LDA #1 ]LUP STA BITMAP,X ;Min bit map (we will do LDA #0 ; the worrying). DEX BPL ]LUP TXS LDX #$11 ;Blank filename in case ]LUP STA FILENAME-1,X ;of multiple use DEX BNE ]LUP STA PFLAG ;Init extra packing flag STA BUFPNT ; and buffer ptr STA COUNT+1 STA COUNT+2 STA PACKFLG ; and packing flag off STA THREE ; and set 0 mod 3 LDA #%11001111 STA BITMAP LDA #"U"&$9F ;Turn on 40 columns JSR COUT JSR HOME STA ALTCHRS ;Enable mousetext JSR WIRE ;Print barbed wire JSR CROUT LDX #14 JSR SENDEXEC ;Print EXEC LDX #2 BIT STARTFLG BMI :LUP LDX #20 :LUP TXA JSR TABV LDA #19 STA CH JSR SENDUT ;Print UTIVE on this line LDY #40 ; & wipe from next :WIP LDA #" " JSR COUT DEY BNE :WIP TYA JSR WAIT DEX CPX #2 BGE :LUP ;Branch till it is on top LDA #3 STA CNT LDA #2 JSR TABV BIT STARTFLG BMI :OVER ;Skip if not initial entry :CLOOP LDX #14 :CLACK JSR CLACK ;Move words out DEX CPX #4 BGE :CLACK ;Till this point :BACK INX JSR CLACK ;Move them back together CPX #14 BLT :BACK LDX #$30 :CLICK BIT SPEAKER ;Make a noise LDY #$C0 :PAUSE INY BNE :PAUSE DEX BNE :CLICK DEC CNT BNE :CLOOP ;Repeat twice more :OVER LDA #7 STA CH JSR SENDMSG ASC "By Glen"00 LDA #27 STA CH JSR SENDMSG ASC "Bredon"8d8d ASC "Produces an EXEC text file from any" HEX 8D ASC "ProDOS file."8d8d ASC "Packed format?"00 JSR YORN STA STARTFLG ROR PACKFLG ;- if packing wanted BPL :STD ;Skip if no packing LDA #6 JSR TABV JSR SENDMSG HEX 8D ASC "4 bit (HEX) or 6 bit packing? (4/6):" BRK :KY JSR RDKEY CMP #"6" BEQ :RR CMP #"4" BNE :KY CLC :RR JSR PUSHOUT BCC :STD LDA #%11000000 ;Signal 6-bit packing mode STA PACKFLG ; by V flag :STD JSR SENDMSG HEX 8D8D ASC "Prefix: "00 DOS getpfx ;PFXPARMS BCS :BMLIERR LDX IN+$40 BEQ :INPUT ;Branch if no pfx :PPF INY LDA IN+$40,Y STA IN-1,Y ORA #$80 JSR COUT ;Show prefix DEX BNE :PPF LDX IN+$40 :INPUT JSR INPUT0 ;Get new pfx BEQ :JEX ;Abort if pfx erased STX IN+$40 :MOVP LDA IN-1,X STA IN+$40,X DEX BNE :MOVP DOS setpfx ;PFXPARMS :BMLIERR BCS :DMLIERR JSR CAT ;Read the catalog JSR SENDMSG ; according to prefix HEX 8D8D ASC "File to convert: "00 LDX #-1 STX SLASHFLG ;Disallow slash and input INX ; at most 15 chars JSR PRFILE ;Start with last cat entry, JSR INPUT ; note this zeros COUNT BNE :ON :JEX JMP EXIT ;Abort if name erased :ON STX IN+$80 STX FILENAME :MOV LDA IN-1,X STA IN+$80,X ;Set name for getinfo etc STA FILENAME,X ;Save inside EXEC file DEX BNE :MOV DOS getinfo ;INFPARMS :DMLIERR BCS :MLIERR LDA #$4A ;Incompat format error LDX INFTYPE CPX #$F BEQ :MLIERR ;Error if a directory STADR IN+$80 ;OPATH JSR OPEN ;Open the source file DOS geteof ;EOFPARMS BCS :MLIERR ; and get its length LDX #PARMEND-PARMS-1 :MVP LDA INFPARMS,X STA PARMS,X ;Save its info in EXEC DEX ; file for setinfo call CPX #ACC-PARMS BGE :MVP LDA EOF+2 STA ZERO ;Zero out the three STA ZERO+1 ; unused info bytes STA ZERO+2 BNE :TOOBIG ;Carry is clear LDA EOF STA SIZ0 STA RWCNT STA PNT LDA EOF+1 STA SIZ1 STA RWCNT+1 ADC #>PROGBUF STA PNT+1 LDA #$8200 CMP EOF LDA #>$8200 SBC EOF+1 :TOOBIG BLT TOOBIG JSR SHOWSPEC ;Show file info and BLT :START ; restart if not ok STADR PROGBUF ;RWBUF DOS read ;RWPARMS ;Load the file BCS :MLIERR DOS close ;CLSPARMS :MLIERR BCS MLIERR LDA #$61 ;Mark end of file for LDY #0 ; packing routines STA (PNT),Y JSR CNTPACK JSR GETDEST ;Ask for dest filename BEQ EXIT STX IN+$C0 :MOVD LDA IN-1,X STA IN+$C0,X DEX BNE :MOVD JSR MAKEFILE ;Write the EXEC file BCC EXIT :START JMP START EXIT DOS close ;CLSPARMS DOS quit ;QPARMS BRK *============================= * MLI error handling and quit: *----------------------------- TOOBIG LDA #$FF ;Fake err code MLIERR PHA PHA DOS close ;CLSPARMS JSR SENDMSG HEX 8D8D ASC "MLI error: $"00 PLA JSR PRBYTE ;Print error code JSR CROUT PLA LDX #ERREND-ERRORS :CERR DEX BMI HIT ;Skip if err code not in tbl CMP ERRORS,X BNE :CERR LDY ERROFF,X :PERR LDA ERRORS,Y BEQ HIT JSR COUT ;Print error message INY BNE :PERR HIT JSR SENDMSG HEX 8D8D ASC "Hit a key"8d00 JSR RDKEY JSTART JMP START *=============================== * Routine to create dest file, * and call file converter. *------------------------------- MAKEFILE STADR IN+$C0 ;OPATH DOS create ;CREPARMS BCC :OK ;Skip if file created ok CMP #$47 ;Duplicate file BNE MLIERR ;Error if not JSR SENDMSG HEX 8D8D ASC "File exists, delete it?"00 JSR YORN BCC JSTART ;Restart if N DOS destroy ;DESPARMS BCC MAKEFILE ;Else create it :MLIERR JMP MLIERR ;Error if locked, etc :OK JSR OPEN ;Open destination file JSR WRTFILE ;Write data to it and close DOS close ;CLSPARMS BCS :MLIERR TAX ;=0 LDY #3 :DOUB LDA COUNT,X ;Double size ROL STA BYT0,X ; and save it STA ADD0,X INX DEY BNE :DOUB DEX ;=2 :MUL ASL ADD0 ;Multiply ADD by 4 ROL ADD1 ; = size x 8 ROL ADD2 INY DEX BNE :MUL :ADD LDA ADD0,X ;Add size x 8 to ADC BYT0,X ; size x 2 to get STA BYT0,X ; size x 10 INX DEY BPL :ADD LDA SIZ1 ;Add (orig size)/2 LSR ; to size x 10 for TAX ; rounding final factor LDA SIZ0 ROR ADC BYT0 STA BYT0 TXA ADC BYT1 STA BYT1 BCC :PER INC BYT2 :PER LDA BYT0 ;Divide this by orig size SBC SIZ0 ; (don't bother setting STA BYT0 ; carry at entry - this is LDA BYT1 ; only an approx anyway. SBC SIZ1 ;Division done by repeated STA BYT1 ; subtraction (quotient LDA BYT2 ; cannot be more than SBC #0 ; about 40). STA BYT2 INY ;Count quotient in Y BGE :PER TYA PHA ;Exp factor x10 JSR HOME JSR SENDMSG HEX 8D8D8D8D00 JSR WIRE ;Start a wire box JSR DWNARROW ;line 2 ASC 'K' ASC " EXEC file length = $"00 LDA COUNT+2 BEQ :SKP JSR PRBYTE :SKP LDA COUNT+1 JSR PRBYTE ;Print length LDA COUNT JSR PRBYTE JSR UPARROW JSR DWNARROW ASC 'K' ASC " Expansion factor = "00 PLA :LX0 LDX #0 :C10 CMP #10 ;Divide exp factor by 10 BLT :DIVD SBC #10 INX ; quotient in X CPX #10 BLT :C10 INY BGE :LX0 :DIVD PHA ;Save remainder TYA BEQ :LESS ORA #"0" JSR COUT :LESS TXA ORA #"0" JSR COUT ;Print integer part LDA #"." JSR COUT PLA ORA #"0" JSR COUT ; and tenths JSR UPARROW BIT BASFLAG BPL :NOBAS ;Skip if not basic JSR DWNARROW ASC 'K' ASC " Longest line length = "00 STY BASFLAG ;Fix so WRTDEC uses COUT LDA MAXLEN+1 LDX MAXLEN JSR WRTDEC ;Print max line length JSR UPARROW :NOBAS JSR DWNARROW ASC 'K' ASC " Another?"00 JSR UPARROW JSR DWNARROW ASC 'K'00 JSR UPARROW JSR WIRE LDA CV SEC SBC #4 JSR TABV ;Position cursor for YORN LDA #10 STA CH JMP YORN ;Exit through YORN WIRE JSR :DIAM ;Print diamond LDX #19 :TOP JSR SENDMSG ;Print barbed wire ASC 'UH'00 DEX BNE :TOP ; then another diamond :DIAM LDA #'[' JMP COUT DWNARROW JSR SENDMSG ;Print down arrows at ASC 'J'00 LDA #39 ; both ends of line STA CH LDA #'J' JSR COUT JMP SENDMSG ;Fall into SENDMSG UPARROW LDA #39 ;Print up arrow at right STA CH ; side of screen LDA #'K' JMP COUT OPEN DOS open ;OPARMS BCS :MLIERR LDA OREF STA EOFREF STA RWREF RTS :MLIERR JMP MLIERR TIMER LDA #'C' ;Hourglass STA $502 STA $525 RTS *============================================ * Routines that actually write the EXEC file. *-------------------------------------------- WRTFILE STADR $100 ;RWCNT ;Set to write one page buf STADR WBUF ;RWBUF LDA INFTYPE CMP #$FC ;BAS file type BNE :NOTBAS JSR SENDMSG HEX 8D8D ASC "Original is a BASIC program, do you"8D ASC "want a listing type EXEC file?"00 JSR YORN BCC :NOTBAS ROR BASFLAG JMP MAKBAS ;Go with Y=0 :NOTBAS JSR TIMER WRITE CALL ;Write CALL-151 LDY #0 STY CHKSUM STY ADRS LDA #>$E00 STA ADRS+1 ;Write setinfo header :HEAD JSR WRTADR0 ;Write line header LDX #$18 ;Count for $18 bytes :HLUP LDA SETINF,Y JSR WRTHEX2 ;Write one hex byte DEX BEQ :LIN LDA SETINF,Y BNE :CONT CPY #FILENAME-SETINF BGE HEAD2 :CONT JSR WRTSPC ;Space after byte INY BNE :HLUP ;Always :LIN LDA SETINF,Y BNE :ON CPY #FILENAME-SETINF BGE HEAD2 :ON LDA ADRS ;Next line CLC ADC #$18 STA ADRS INY BNE :HEAD ;Always (less that 1 page) HEAD2 BIT PACKFLG BPL :HDONE ;Skip if no packing LDY #0 STY ADRS LDA #>$F00 STA ADRS+1 ;Write unpacker header STADR READSQZ ;PNT BVC :HEAD ;Branch if 4-bit mode STADR RS6 ;PNT BIT PFLAG BPL :HEAD ;Branch for standard 6-bit STADR RS6P ;PNT :HEAD JSR WRTADR0 ;Write line header LDX #$18 ;Count for $18 bytes :HLUP LDA (PNT),Y BNE :WRIT INY LDA (PNT),Y ;Check for 2-0s end mark BEQ :F00G DEY LDA (PNT),Y :WRIT JSR WRTHEX2 ;Write one hex byte INY INY LDA (PNT),Y DEY DEX BEQ :LIN ORA (PNT),Y BEQ :F00G JSR WRTSPC ;Space after byte JMP :HLUP :LIN ORA (PNT),Y ;Check end mark BEQ :F00G LDA ADRS ;Next line CLC ADC #$18 STA ADRS BCC :HEAD ;Always :F00G JSR WRTCR WRITE F00G :HDONE STADR LOADADR ;ADRS ;Set to write code STADR PROGBUF ;PNT ;Actual code adrs LDA #$18 STA LINLEN ;24 bytes for ord dump LDA EOF EOR #$FF STA CNT ;Calculate for count up LDA EOF+1 EOR #$FF STA CNT+1 INCD CNT BEQ :DONE ;Safety if no file :LINLUP BIT PACKFLG BPL :WAD LDA #$20 ;32 bytes/line if pack-4 BVC :SL LDA #$30 ;48 if pack-6 :SL STA LINLEN JSR WRTCR BIT PACKFLG BVC :NOADR LDA #LINSTART JSR WRTBYTE ;Avoid DOS commands JMP :NOADR :WAD JSR WRTADR ;Write line header :NOADR LDX LINLEN ;Count for $18/20/30 bytes :LUP LDY #0 LDA (PNT),Y EOR CHKSUM STA CHKSUM LDA (PNT),Y CMP #$61 BEQ :WH ;Skip pack if endmark chr BIT PACKFLG BVC :WH ; or 4-bit or std mode BIT THREE BMI :WH ; or 4 byte packet undone BIT PFLAG BPL :WH ; or std 6-bit mode. :IY INY BMI :DOIT CMP (PNT),Y ;Check for repetitions BEQ :IY :DOIT DEY ;Max $7F TYA CMP #3 BLT :WH ;Skip if < 4 reps JSR PACKBYTS ;Make packed packet BCS :DONE BCC :DX :WH LDY #0 LDA (PNT),Y JSR WRTHEX ;Write one byte INCD CNT BEQ :DONE ;Exit when code done INCD ADRS ;Bump fake adrs INCD PNT ; and actual adrs :DX DEX BEQ :LINLUP ;Branch if new line BIT PACKFLG BMI :LUP JSR WRTSPC ;Else write space JMP :LUP :DONE BIT PACKFLG BPL :NOCHK LDA CHKSUM ;Write checksum if packed JSR WRTHEX :NOCHK JSR WRTCR BIT PACKFLG BPL :FIN JSR WRTCR ;Empty line if packed :FIN WRITE BSAVE ;Write BSAVE WRITE IN+$80 ; and filename WRITE AD ; and A parameter, etc LDA EOF+1 JSR WRTHEX2 ;Write L parameter LDA EOF JSR WRTHEX2 JSR WRTCR ;CR BIT PACKFLG BPL :C3 WRITE CALL2 ;Write E00G if packed JMP FINISH :C3 WRITE CALL3 ;Write E05G if not packed FINISH JSR WRTCR LDA BUFPNT ;If buffer done, skip BEQ :RET ; else write it JSR WRTBUF LDX #2 :CL LDA COUNT,X ; and set correct length STA EOF,X DEX BPL :CL DOS seteof ;EOFPARMS BCS ERR :RET RTS WRTADR0 JSR WRTCR LDA ADRS+1 JSR WRTNIB JMP WA2 WRTADR JSR WRTCR ;Write line header LDA ADRS+1 JSR WRTHEX2 WA2 LDA ADRS JSR WRTHEX2 LDA #":" BNE WRTBYTE WRTHEX BIT PACKFLG BVC WRTHEX2 ;Branch if not pack-6 STX XSAV PHA LDX THREE ;Take abs val of count TXA EOR #-1 TAX INX ; use as index to temp bytes PLA ASL ;Shift off top two bits & PHP ; put into BYT0 ASL ROR BYT0 PLP ROR BYT0 STA BYT1,X ;Store byte*4 in BYT1,2,3 CPX #2 BEQ :OFF LDX XSAV ;Exit if have not processed DEC THREE ; all three bytes RTS :OFF LDX #6 ;Reverse the order of the LDA #0 ; six bits in BYT0 :SHFT ASL BYT0 ROR DEX BNE :SHFT STA BYT0 ;They are now in high-low STX THREE ; order with 1st one at :SEND LDA BYT0,X ; top LSR LSR CLC ADC #$3F JSR WRTBYTE ;Write to file. INX CPX #4 BLT :SEND ;Send all 4 bytes LDX XSAV RTS ERR JMP MLIERR WRTHEX2 PHA ;Write hex byte LSR LSR ~ LSR LSR JSR WRTNIB PLA AND #$F WRTNIB ORA #"0" CMP #"9"+1 BLT WRTBYTE ADC #6 HEX 2C WRTCR LDA #$8D BIT PACKFLG ;If not 6-bit packed BVC WRTBYTE ; then write CR BIT THREE ;Same if #=0 mod 3 BPL WRTBYTE LDA #0 ;Else write 0s until it is JSR WRTHEX JMP WRTCR ;Loop while # not 0 mod 3 WRTSPC LDA #" " WRTBYTE AND #$7F ;Write (pos) ascii byte STY YSAV LDY BUFPNT STA WBUF,Y ;Wait for 1 page before LDY YSAV ; sending to MLI INC COUNT ;Count EXEC file size BNE :IB INC COUNT+1 BNE :IB INC COUNT+2 :IB INC BUFPNT ;Fall into WRTBUF if BNE RTN ; buffer full WRTBUF DOS write ;RWPARMS BCS ERR RTN RTS PACKBYTS LDA #"0" JSR WRTBYTE ;Write special signature LDA (PNT),Y AND #%11 CLC ADC #$3F JSR WRTBYTE ;Low two bits LDA (PNT),Y EOR CHKSUM STA CHKSUM ;Correct checksum LDA (PNT),Y LSR LSR CLC ADC #$3F JSR WRTBYTE ;Upper six bits DEY TYA LSR ;Max $7E/2 = $3F CLC ADC #$3F JSR WRTBYTE ;Length of segment/2-1 INY INY TYA LSR ;Always even ASL ;Clears carry TAY ;Length of segment ADC CNT ;Bump pointers STA CNT BCC :ON INC CNT+1 BEQ :RET ;Carry set this exit CLC :ON TYA ADC PNT STA PNT BCC :DX INC PNT+1 CLC ;Signal more to do :DX DEX DEX :RET RTS *=============================== * Routine to count repetitions * to decide packing mode *------------------------------- CNTPACK BIT PACKFLG ;Ignore if not in 6-bit mode BVC :RET LDX #0 STX FPNT LDA #>PROGBUF STA FPNT+1 :NXCNT LDY #0 LDA (FPNT),Y ;Get a byte :LUP INY BMI :SETFLG ;Pack if 128 byte segment CMP #$61 ;Ignore end mark char BEQ :SY CMP (FPNT),Y BEQ :LUP ;Loop if same as last :SY STY YSAV ;= length of segment CPY #8 ;Ignore if short BLT :OV :TYX DEY ;Transfer Y to running BEQ :OV ; counter in X INX BPL :TYX ;If total>127 then pack :SETFLG SEC ;Signal extra packing mode ROR PFLAG :RET RTS :OV LDA YSAV ;Bump pointer past segment CLC ADC FPNT STA FPNT BCC :DONE INC FPNT+1 :DONE CMP PNT LDA FPNT+1 SBC PNT+1 BLT :NXCNT ;Loop till prog done RTS *============================ * Routine to write BASIC file *---------------------------- MAKBAS JSR TIMER LDY #0 STY PACKFLG ;Defeat packing request STY LEN STY LEN+1 STY MAXLEN STY MAXLEN+1 STY PNT LDA #>PROGBUF STA PNT+1 ;Point to file WRITE NEW ;Send "NEW" JSR WRTCR :BASLUP LDA LEN ;Set max if line length CMP MAXLEN LDA LEN+1 SBC MAXLEN+1 BLT :SHORT MOVD LEN ;MAXLEN :SHORT LDY #0 STY LEN ;Restart line len count STY LEN+1 INY LDA (PNT),Y ;Link hi BEQ :DONE ;Done if link hi is zero INY LDA (PNT),Y ;Line # low TAX INY LDA (PNT),Y ; " hi JSR WRTDEC ;Send line number LDA PNT ;Point to 1st char of line CLC ADC #4 STA PNT BCC :LINLUP INC PNT+1 :LINLUP LDY #0 LDA (PNT),Y BEQ :ENDLIN ;Branch on end of line BMI :ISTOK ;Branch on token :WRT JSR WRTBAS ;Write non-token :NXT INCD PNT ;Point to next char BNE :LINLUP ;Branch always :ISTOK CMP #186 ;PRINT token? BNE :TOK LDA #'?' ;Substitute "?" BNE :WRT :TOK TAX ;Tok in X for table lookup STADR TOKENS-1 ;FPNT :DX DEX BPL :GOTTOK ;Pointing to word in table :LOOK INCD FPNT ; when X goes positive LDA (FPNT),Y BEQ :ERR ;Should not happen EOR TOKENS ;Support for Laser-128 BPL :LOOK ;Branch if word not done BMI :DX ;Count the word :GOTTOK INCD FPNT ;Point to next word LDA (FPNT),Y PHA JSR WRTBAS ;Send it PLA EOR TOKENS ;Support for Laser-128 BPL :GOTTOK ;Loop till word sent BMI :NXT ;Then back to program :ERR LDA #0 ;Illegal token, abort JMP MLIERR :ENDLIN JSR WRTCR ;End line with CR INCD PNT JMP :BASLUP ;Next line :DONE WRITE SAVE ;Send "SAVE " WRITE IN+$80 ; and filename JMP FINISH ; and go wind it up. *====================================== * Line number printer for BASIC listing *-------------------------------------- WRTDEC STA NH ;Save # STX NL LDX #9 ;Loop count STX NFL ; and table index :LOAD0 LDY #"0" :DIV LDA NL CMP :NUMTBL-1,X LDA NH SBC :NUMTBL,X ;Compare w power of 10 BCC :DIVD ;If less then have quot. STA NH LDA NL ;Else subtract that power SBC :NUMTBL-1,X STA NL INY ; count quotient BNE :DIV ; and branch always :DIVD TYA ;Y has quotient in ascii DEX BEQ :PRD ;Always write final digit CMP #"0" BEQ :PDIG STA NFL ;Flag a nonzero digit :PDIG BIT NFL BPL :NXDIG ;Skip leading zeros :PRD JSR WRTBAS0 :NXDIG DEX BPL :LOAD0 RTS :NUMTBL DA 1,10,100,1000,10000 WRTBAS0 BIT BASFLAG ;If BASFLAG is + BMI WRTBAS JMP COUT ; then print to screen WRTBAS INCD LEN ; else count the byte JMP WRTBYTE ; and write to file *=============================== * Routine to show specifications * of file to be converted. *------------------------------- SHOWSPEC LDA #10 JSR TABV JSR CLREOP JSR SENDMSG HEX 8D ASC "File name: "00 LDX IN+$80 :PN INY LDA IN+$80,Y JSR COUT DEX BNE :PN JSR SENDMSG HEX 8D ASC "File type: "00 LDA INFTYPE LDY #TYPEND-TYPES-1 ]LUP CMP TYPES,Y ;Check name list BNE :NO LDX #3 :PT LDA TYPES-3,Y JSR COUT INY DEX BNE :PT BEQ :SKP ;Skip hex routine :NO DEY DEY DEY DEY BPL ]LUP ;Loop till through list :USEH PHA ;Not found save type LDA #"$" JSR COUT PLA JSR PRBYTE ;Print file type :SKP JSR SENDMSG HEX 8D ASC "Aux type: $"00 LDA INFAUX+1 JSR PRBYTE LDA INFAUX JSR PRBYTE JSR SENDMSG HEX 8D ASC "File size: $"00 LDA EOF+1 JSR PRBYTE LDA EOF JSR PRBYTE JSR SENDMSG HEX 8D8D ASC "Ok?"00 YORN JSR SENDMSG ASC " (Y/N):"00 ]LUP JSR RDKEY CMP #"["&$9F BEQ QUIT AND #%11011111 CMP #"Y" BEQ PUSHOUT EOR #"N" BNE ]LUP LDA #"N" PUSHOUT PHP JSR COUT PLP RTS ;Returns with CS if Y QUIT JMP EXIT *============================= * Input routine, headed by get * destination EXEC file name. *----------------------------- GETDEST LDA #15 JSR TABV JSR CLREOP JSR SENDMSG HEX 8D ASC "Name of EXEC file to create:"8d00 LDX STARTUP BEQ INPUT0 ;Skip if no startup :LUP INY LDA STARTUP,Y ;Print the startup ORA #$80 CMP #"A" BLT :NU AND #%11011111 :NU STA IN-1,Y ;And save it as if typed JSR COUT DEX BNE :LUP LDX STARTUP INPUT0 LSR SLASHFLG INPUT TXA TAY LDA #" " :FAKE STA IN,Y ;Defeat illegal picks INY CPY #$40 BLT :FAKE :KEY JSR RDKEY CMP #"U"&$9F ;But support after backspc BNE :NOU LDA IN,X ;Pick from previous input ORA #$80 :NOU CMP #"." BEQ :OK CMP #$FF BEQ :BS CMP #$88 BEQ :BS BIT SLASHFLG BPL :SLS ;Skip if not orig filename LDY IN+$40 BEQ :SLS ; or no prefix CMP #"K"&$9F BEQ :DP CMP #"J"&$9F BNE :NOSL JSR INCPNT ;Next cat entry LDY #0 LDA (FPNT),Y ;Ignore if no more BNE :PRFILE :DP JSR DECPNT ;Previous cat entry :PRFILE JSR ERASE ;Erase current name JSR PRFILE ;Print next one JMP :KEY :SLS CMP #"/" BEQ :OK :NOSL CMP #$8D BEQ :DONE CMP #"["&$9F ;ESC at any input returns BEQ :ABORT ; to program start. CMP #"0" BLT :KEY CMP #"9"+1 BLT :OK CMP #"A" BLT :KEY AND #%11011111 CMP #"Z"+1 BGE :JKEY :OK STA IN,X JSR COUT INX CPX #$10 BLT :JKEY BIT SLASHFLG ;Length of source file BMI :BS ; at most 15 CPX #$40 ;Other input to 63 BLT :JKEY :BS TXA BEQ :JKEY DEX JSR BACKSPC :JKEY JMP :KEY :DONE TXA RTS :ABORT JMP START BACKSPC JSR :BS ;Backspace LDA #" " JSR COUT ;Wipe previous char :BS LDA #$88 JMP COUT ; & backspace again PRFILE LDY #0 LDA (FPNT),Y STA COUNT ;Name length BEQ :ZERO ;Ignore if no name :NY INY LDA (FPNT),Y ORA #$80 STA IN,X ;Save as if from keybd JSR COUT INX DEC COUNT BNE :NY :ZERO LDA #0 STA IN,X ;Mark for pick RTS ERASE TXA ;X holds cursor pos BEQ :RET :BS JSR BACKSPC DEX BNE :BS :RET RTS SENDEXEC STX CH JSR SENDMSG ASC " EXEC"00 RTS SENDUT JSR SENDMSG ASC "UTIONER "00 RTS CLACK JSR SENDEXEC ;Print "EXEC" TXA EOR #$FF ;Calculate # of middle CLC ; spaces ADC #15 ASL TAY BEQ :NOS :SPC LDA #" " JSR COUT ; and print them DEY BNE :SPC :NOS JSR SENDUT ; then print "UTIONER" LDA #$40 JMP WAIT ;Let him see it *=========================== * Strings put into EXEC file *--------------------------- CALL STR "CALL-151" CALL2 STR "E00G" CALL3 STR "E05G" AD STR ",A$1000,L$" ERR LOADADR-$1000 F00G STR "F00G" BSAVE STR "BSAVE " SAVE STR "SAVE " NEW STR "NEW" *=============================== * Parameter tables for this pgm. *------------------------------- CLSPARMS DFB 1 DFB 0 QPARMS DFB 4 DFB 0 DA 0 DFB 0 DA 0 INFPARMS DFB 10 DA IN+$80 DFB 0 INFTYPE DFB 0 INFAUX DA 0 DFB 0 DA 0 DA 0,0 DA 0,0 OPARMS DFB 3 OPATH DA IN+$80 DA FILEBUF ;File buffer OREF DFB 0 EOFPARMS DFB 2 EOFREF DFB 0 EOF DFB 0,0,0 RWPARMS DFB 4 RWREF DFB 0 RWBUF DA PROGBUF ;File load adrs RWCNT DA 0 DA 0 CREPARMS DFB 7 DA IN+$C0 DFB $C3 DFB 4 ;Text DA 0 DFB 1 DA 0,0 DESPARMS DFB 1 DA IN+$C0 PFXPARMS DFB 1 DA IN+$40 VAR TXTP ;COUT PUT /HARD1/MERLIN/LIB/SENDMSG *================== * Catalog routines: *------------------ GOERR JMP MLIERR CAT LDA #0 STA RWCNT STA RWBUF LDA #2 ;Read 1 block STA RWCNT+1 LDA #>CATBUF STA RWBUF+1 STADR IN+$40 ;OPATH JSR OPEN ;Open dir of the pfx DOS read ;RWPARMS BCS GOERR MOVD CATBUF+$23 ;LEN JSR SETPNT STADR FILES ;FPNT ACTLOOP DEC THISCNT BNE NXFIL DOS read ;RWPARMS BCS :CD ;Had eof JSR SETPNT BNE ISACT ;Always :CD JMP CATDONE SETPNT LDA ENTPER ;Get entries/block STA THISCNT ; and point to start STADR CATBUF+4 ;PNT RTS NXFIL LDA PNT ;Point to next file CLC ADC LEN STA PNT BCC ISACT INC PNT+1 ISACT LDY #0 LDA (PNT),Y BEQ ACTLOOP ;Branch if file not active * Process active file: AND #$F TAX ;Name length LDY #$10 LDA (PNT),Y CMP #$F BEQ ACTLOOP ;Ignore directories LDY #0 TXA STA (FPNT),Y ;Save name length ]LOOP INY LDA (PNT),Y ; and file name ORA #$80 STA (FPNT),Y DEX BNE ]LOOP JSR INCPNT ;Bump pointer LDA FPNT+1 CMP #>$BE00 BLT ACTLOOP ;Plenty of space CATDONE DOS close ;CLSPARMS LDY #0 TYA STA (FPNT),Y ;Mark end of catalog DECPNT LDA FPNT ; & point to last entry SEC SBC #$10 STA FPNT BCS :RET DEC FPNT+1 LDA FPNT+1 CMP #>FILES ;If backed up too far then BLT INCPNT ; go back where we were :RET RTS INCPNT LDA FPNT CLC ADC #$10 STA FPNT BCC :RET INC FPNT+1 :RET RTS *================= * MLI error tables *----------------- ERRORS HEX 27,2B,40,44,45,46,47,48,49,4A,FF,00 ERREND ERROFF DFB :IO-ERRORS DFB :WRTPROT-ERRORS DFB :INVPATH-ERRORS DFB :DIRNOT-ERRORS DFB :VOLNOT-ERRORS DFB :FILENOT-ERRORS DFB :DUP-ERRORS DFB :VOLFUL-ERRORS DFB :DIRFUL-ERRORS DFB :BADFORM-ERRORS DFB :TOOBIG-ERRORS DFB :BADBAS-ERRORS :IO ASC "I/O error"00 :WRTPROT ASC "Write protected"00 :INVPATH ASC "Invalid pathname"00 :DIRNOT ASC "Directory not found"00 :VOLNOT ASC "Volume not found"00 :FILENOT ASC "File not found"00 :DUP ASC "Duplicate filename"00 :VOLFUL ASC "Volume full"00 :DIRFUL ASC "Volume directory full"00 :BADFORM ASC "Incompatible file type"00 :TOOBIG ASC "File too large"00 :BADBAS ASC "Defect in BASIC program"00 ERR *-ERRORS/$100 PAG *======/A/ASM/SRC================================ * Header code written at start of file and called * at the end of EXEC to set pfx & file info. *------------------------------------------------ SETINF ORG $E00 SEC LDA CHKSUM BNE :SINF ERR *-$E05 CLD JSR CROUT LDA DEVNUM ;Set current unit for STA :ONLUNIT ; getting the vol name DOS getpfx ;:PFXP ORA IN+$80 ;Error or BNE :SINF ; use prefix if there DOS online ;:ONLP BCS :SINF LDA IN+$81 ;Else use volume name AND #$F TAX INX STX IN+$80 LDA #'/' STA IN+$81 DOS setpfx ;:PFXP :SINF LDX #:ERR-:ALL ;Prepare to send err msg BCS :MLIERR DOS setinfo ;PARMS-SETINF+$E00 BCS :MLIERR LDX #FILEINF-:ALL+FILENAME-NOWINF+1 JSR :PRINT TAX :MLIERR JSR :PRINT ;Print "error" or JMP DOSWARM ; "saved" :OUT JSR COUT INX :PRINT LDA :ALL,X BNE :OUT RTS :ALL ASC " saved"8D00 :ERR ASC "Error"878D00 :ONLP DFB 2 :ONLUNIT DFB 0 DA IN+$81 :PFXP DFB 1 DA IN+$80 FILEINF ORG NOWINF PARMS DFB 7 DA FILEINF+FILENAME-NOWINF ACC DFB 0 DFB 0 DA 0 ZERO DFB 0 DA 0 DA 0,0 PARMEND FILENAME DS $11 ;Need one 0 for stopper SIEND ERR SIEND-SETINF/$FF *======================================== * Decoder for 4-bit packing. This is * just a hex representation of the bytes. *---------------------------------------- READSQZ ORG $F00 CLD LDY #0 STY CHKSUM DEY STY PNT LDA #$F STA PNT+1 ;Will put code at LOADADR LOOP JSR GETLNZ ;Read a line of file LDY #0 LDX #-1 NXTBYTE JSR MAKNIB INCD PNT ASL ASL ASL ASL STA (PNT),Y ;Store in buffer LOADADR- JSR MAKNIB ORA (PNT),Y STA (PNT),Y EOR CHKSUM STA CHKSUM BCC NXTBYTE MAKNIB INX LDA IN,X ORA #$80 CMP #" " BEQ MAKNIB ;Skip spaces EOR #"0" ;Convert ascii digit CMP #10 ; to hex nibble. BLT :GOT ADC #$88 ORA #$20 CMP #$FA BGE :MASK PLA PLA CPX #4 BGE LOOP TYA STA (PNT),Y ;Zero checksum JMP MONITOR :MASK CLC ;Signal digit valid AND #$F :GOT RTS DFB 0,0 ;End of code marker ORG *============================================= * Decoder for 6-bit packed packing. Like reg * 6-bit packing but has special code with 1st * byte '0' next two the repeated byte (stored * 00000011 then 11111100) and last byte the * count-2/2, count always is even. *--------------------------------------------- RS6P ORG $F00 CLD LDY #0 STY CHKSUM STY PNT LDA #>LOADADR STA PNT+1 ;Will put code at LOADADR :LOOP JSR GETLNZ ;Read a line of file CPX #5 BLT :MON ;Next line till empty LDX #0 :NXTBYTE JSR :MAKNIB ;Get top 2 bits for STA TEMP ; next 3 bytes LDY #-1 ROR FLAG :UNPACK INY JSR :MAKNIB ;Get a data 6-bit nibble ASL TEMP ;Shift on its top 2 bits ROR ASL TEMP ROR STA (PNT),Y BIT FLAG BMI :SKIP EOR CHKSUM STA CHKSUM :SKIP CPY #2 BLT :UNPACK ;Loop till unpacked 3 bytes BIT FLAG BPL :TY ROL ;Top bits clr, carry set STA TEMP ;Count-1 DEY LDA (PNT),Y ASL ASL ;Clears carry DEY ORA (PNT),Y :STR STA (PNT),Y INY DEC TEMP ;Count down the repetition BPL :STR :TY TYA ADC PNT ;Bump pntr to next group STA PNT BCC :NXTBYTE INC PNT+1 BCS :NXTBYTE :NOTLEG PLA PLA BCC :LOOP :Always :MON JMP MONITOR ;Call monitor to do rest :MAKNIB INX LDA IN,X ASL CMP #' '*2 BEQ :MAKNIB ;Skip over spaces EOR #'0'*2 BEQ :RET EOR #'0'*2 SBC #$3F*2 BLT :NOTLEG ;Abort if not in range ASL ;Shift to top for easier :RET RTS ; unpacking DFB 0,0 ;End of code marker ORG *=============================== * Regular 6-bit decoder routine: *------------------------------- RS6 ORG $F00 CLD LDY #0 STY CHKSUM STY PNT LDA #>LOADADR STA PNT+1 ;Will put code at LOADADR :LOOP JSR GETLNZ ;Read a line of file CPX #5 BLT :MON LDX #0 :NXTBYTE JSR :MAKNIB ;Get top 2 bits for STA TEMP ; next 3 bytes LDY #-1 :UNPACK INY JSR :MAKNIB ;Get a data 6-bit nibble ASL TEMP ;Shift on its top 2 bits ROR ASL TEMP ROR STA (PNT),Y ;Store in buffer LOADADR- EOR CHKSUM STA CHKSUM CPY #2 BLT :UNPACK ;Loop till unpacked 3 bytes TYA ADC PNT ;Bump pntr to next group STA PNT ;Carry is set BCC :NXTBYTE INC PNT+1 BCS :NXTBYTE :MAKNIB INX LDA IN,X ASL CMP #' '*2 BEQ :MAKNIB ;Skip over spaces SBC #$3F*2 BLT :NOTLEG ;Abort if not in range ASL ;Shift to top for easier RTS ; unpacking :NOTLEG PLA PLA BLT :LOOP ;Next line, always taken :MON JMP MONITOR ;Call monitor to do rest DFB 0,0 ;End of code marker ORG ENDPRG ERR \$3000 DO SAVOBJ SAVE EXECUTIONER FIN