TITLE 'SUBROUTINES'›SUBTTL 'File SUBRS.AMA'›;›; Utility subroutine library›;›;›;******************›;›;       WRTOP›;›;******************›;›; Writes an operand (system or internal label)›; into the text line buffer.›;›; Enter ADRBUF(2)=referenced address›;       X=offset (from LINEBF) to start writing›;›; Exit  X=offset of next available output byte›PROC›WRTOPTXA;Save X›PHA›JSR GETSYS;System label?›BCS :WRT1;No›JSR ADRSYS;Yes, get its address›PLA     ;and output it›TAX›JSR WRTSYS›RTS›:WRT1JSR GETLAB;Get label ID›PLA›TAX›JSR WRTLAB;Output it›RTS›EPROC›;›;›;*******************›;›;      ADRSYS›;›;*******************›;›; Computes memory address of a system label.›;›; Enter SYSBAS(2)=page base address›;       ADRBUF=address lo byte›; Exit  SYSACC(2)=pointer to label›;›; Preserves X register›;›PROC›ADRSYSLDA #0›STA SYSACC›STA SYSACC+1›;›; Multiply ADRBUFx6 to get offset from SYSBAS›;›LDY #6›:LP1CLC›LDA SYSACC›ADC ADRBUF›STA SYSACC›LDA SYSACC+1›ADC #0›STA SYSACC+1›DEY›BNE :LP1›;›; Now add it to SYSBAS›;›CLC›LDA SYSACC›ADC SYSBAS›STA SYSACC›LDA SYSACC+1›ADC SYSBAS+1›STA SYSACC+1›RTS›EPROC›;›;›;*********************›;›;       GETSYS›;›;*********************›;›; Checks an address for system references.›;›; Enter ADRBUF(2)=referenced address›; Exit  SYSBAS(2)=base address of system page group›;       ADRBUF=system address lo byte›;       Carry=Clear (system location)›;  Set (not system location)›;›PROC›GETSYSLDX #0›:GS2CPX #[PTBEND-PAGTAB]›BCS :GSBAD›LDA PAGTAB,X;Sys page addr (lo)›STA SYSBAS›INX›LDA PAGTAB,X;Sys page addr (hi)›STA SYSBAS+1›INX›LDA PAGTAB,X;Sys page number›STA PAGNO›INX›LDA PAGTAB,X;Sys page top›STA PAGTOP›INX›LDA PAGTAB,X;Read/write access flag›STA WRTFLG›INX›LDA PAGNO;Look at page nr›CMP ADRBUF+1;Are we on this page?›BNE :GS2;No, try another›LDA PAGTOP›CMP ADRBUF;Within page limits?›BCC :GSBAD;No, bomb out›LDA WRTFLG;Yes, get page access direction›BMI :GSOK;Don't care, go on›JSR RDORWR;Get kind of instruction›CMP WRTFLG;and compare with page type›BNE :GS2 ;Mismatch, go back›:GSOKCLC   ;Success›RTS›:GSBADSEC   ;Failure›RTS›EPROC›;›;›;********************›;›;       WRTSYS›;›;********************›;›; Writes a system label (with offset if applicable)›; into the text line buffer.›;›; Enter SYSACC(2)=address of label›;X=offset (from LINEBF) of operand›;ExitX=offset of next byte›;›PROC›WRTSYSLDY #0›STY SYSOFF;Assume no offset›LDA (SYSACC),Y;Get first byte›AND #$7F;Remove referenced bit›CMP #'x';Offset flag?›BNE :NOOFF;No, no offset›INY ;Yes, get offset›LDA (SYSACC),Y›STA SYSOFF;Save it›;›; Now we have the address in SYSACC and the offset›; from the system label in SYSOFF. Next we have to›; back up 6xSYSOFF to find the actual label.›;›LDY #6›:MLTSSEC;Multiple subtraction loop›LDA SYSACC›SBC SYSOFF›STA SYSACC›LDA SYSACC+1›SBC #0›STA SYSACC+1›DEY›BNE :MLTS›:NOOFFLDY #0›:LP1LDA (SYSACC),Y;Move label into LINEBF›AND #$7F;Clear hi bit›CMP #' '›BEQ :CKOFF›STA LINEBF,X›INX›INY›CPY #6›BCC :LP1›:CKOFFLDA SYSOFF ;Offset?›BNE :OFF;Yes, process it›RTS;No, we're done.›:OFFLDA #'+'›STA LINEBF,X›INX›TXA›PHA;Save X›LDA SYSOFF›STA FR0;Convert offset to ASCII›LDA #0›STA FR0+1›JSR IFP›JSR FASC›PLA;Recover X›TAX›JSR WRTNUM;Output offset›RTS;and hang it up.›;›;********************›;›;       GETLAB›;›;********************›;›; Computes the ID number of the internal label›; represented by an address.›;›; Enter ADRBUF(2)=referenced address›;›; Exit  LABEL(2)=label ID›;Carry=Clear (label found)›;      Set (no label)›;›PROC›GETLABLDA #LOW LABBAS;Initialize›STA LABACC; the label pointer›LDA #HIGH LABBAS›STA LABACC+1›:LOOPCLC›LDA LABACC›ADC #2;Step pointer›STA LABACC›LDA LABACC+1›ADC #0›STA LABACC+1›LDY #0›LDA (LABACC),Y;Label address=loc counter?›CMP ADRBUF›BNE :NOMAT›INY›LDA (LABACC),Y›CMP ADRBUF+1›BNE :NOMAT›SEC;Yes, compute label #.›LDA LABACC;Get table offset›SBC #LOW LABBAS›STA LABEL›LDA LABACC+1›SBC #HIGH LABBAS›STA LABEL+1›LSR LABEL+1;and divide by 2›ROR LABEL;and we have the label number.›:GLXITCLC;Signal success›RTS;and we're done.›:NOMATSEC;No match›LDA LABACC;So are we out of labels?›SBC LABTOP›LDA LABACC+1;Don't need to store›SBC LABTOP+1›BCC :LOOP;No, try another.›LDA #0;Yes, flag the failure.›STA LABEL›STA LABEL+1›SEC›:EXIT RTS;and we're done.›EPROC›;›;›;******************›;›;      FLGLAB›;›;******************›;›; Subroutine to flag a label number as "internal"›; in the label map,or to unflag it.›;›; Enter LABEL(2)=label number›; Acc=0 (unflag)›;     nonzero (flag)›;›; No exit parameters.›;›PROC›FLGLABPHA    ;Save acc key›LDX LABEL    ;Locate label flag›LDY LABEL+1›JSR MAPACC›LDA LABMAP,X›ORA MASK,Y›STA LABMAP,X;Set it›PLA    ;Get key›BNE :EXIT;Flag, we're done›LDA LABMAP,X;Unflag›EOR MASK,Y;So clear the bit›STA LABMAP,X›:EXITRTS›EPROC›;›;›;******************›;›;      WRTLAB›;›;******************›;›; Writes an internal label into the output text buffer.›;›; Enter LABEL(2)=label ID›;X=offset (from LINEBF) to label›; Exit  X=offset to next output byte›;›PROC›WRTLABLDA LABEL;Does a label exist?›BNE :DOIT;Yes, do it›LDA LABEL+1›BNE :DOIT›LDA #'$';No, table full, enter›STA LINEBF,X;the address instead.›INX›LDY #1›:LPLDA ADRBUF,Y›JSR WRTHEX›DEY›BPL :LP›RTS›:DOITTXA›STA TEMP›PHA;Save X›LDA LABEL›STA FR0;Convert to ASCII›LDA LABEL+1›STA FR0+1›JSR IFP›JSR FASC›PLA›TAX;Recover X›;›; The label number is to be 4-digit fixed-field so›; now we index to the 4th digit.›;›INX›INX›INX›INX›TXA  ;Save X›PHA›;›; Now use Y to find the index to last byte›; of label nr in the FP buffer.›;›LDY #$FF›:LP2INY›LDA (INBUFF),Y;Bit 7 set?›BPL :LP2;No, try another›;›; Found the offset. Now move label nr to buffer›;›:LP4LDA (INBUFF),Y›AND #$7F›STA LINEBF,X›DEX›DEY›BPL :LP4›LDA #'0'›:LP6CPX TEMP›BEQ :PREF›STA LINEBF,X›DEX›JMP :LP6›;›; Now insert the label prefix: Z if zero-page,›; L otherwise›;›:PREFLDA #'L'›LDY ADRBUF+1›BNE :NOTZP›LDA #'Z'›:NOTZPSTA LINEBF,X›PLA  ;Recover X›TAX›INX   ;Index to next byte›RTS›EPROC›;›;          ›;********************›;›;      WRTNUM›;›;********************›;›; Writes an ASCII number into the output text buffer.›;›; Enter INBUFF(2) points to ASCII number›;X=offset (from LINEBF) to first digit›; Exit  X=offset to next output byte›;›; Note:expects ASCII number in the format generated›; by the FP package (variable field length, high bit›; set in last BCD digit).›;›PROC›WRTNUMDEX›LDY #$FF›:LP1INX›INY›LDA (INBUFF),Y;Get BCD digit›STA LINEBF,X›BPL :LP1 ;Last byte?›AND #$7F ;Yes, clear high bit›STA LINEBF,X;and store again.›INX;Index next byte›RTS;and split.›EPROC›;›;›;*******************›;›;       LNNUM›;›;*******************›;›; Subroutine to attach a source line number,›; incrementing the current number in NUMBUF.›;›; No parameters.›;›PROC›LNNUMLDX #3;Operate on 10's digit›:LN2LDY NUMBUF,X›INY›CPY #':'›BCC :LN4›LDA #'0'›STA NUMBUF,X›DEX›BPL :LN2›:LN4TYA›STA NUMBUF,X›RTS›EPROC›;›;›;*******************›;›;       FLGSYS›;›;*******************›;›; Flags a system label to indicate it has›; been referenced.›;›; Enter SYSBAS(2)=system page base address›;ADRBUF=address lo byte›; Exit  byte 0 of label has high bit set›;›PROC›FLGSYSJSR ADRSYS;Get label address›LDY #0›LDA (SYSACC),Y;Get byte 0›AND #$7F;Clear hi bit›CMP #'x';Offset location?›BNE :NOOFF›INY›LDA (SYSACC),Y›STA SYSOFF›LDY #6›:LPSEC›LDA SYSACC›SBC SYSOFF›STA SYSACC›LDA SYSACC+1›SBC #0›STA SYSACC+1›DEY›BNE :LP›:NOOFFLDY #0›LDA (SYSACC),Y›ORA #$80;Set high bit›STA (SYSACC),Y;and restore.›RTS›EPROC›;›;›;*********************›;›;       ENTERL›;›;*********************›;›; Enters an address in the label table.›;›; Enter ADRBUF(2)=address to enter›; No exit params.›;›PROC›ENTERLSEC;Is label table full?›LDA LABCNT›SBC #LOW[BIGBUF-LABBAS-2]›LDA LABCNT+1›SBC #HIGH[BIGBUF-LABBAS-2]›BCS :ENXIT›;›; Carry must be clear›;›LDA LABCNT;2x nr of labels›ADC #2;Increment it›STA LABCNT›LDA LABCNT+1›ADC #0›STA LABCNT+1›CLC›LDA #LOW LABBAS›ADC LABCNT;Add to table base›STA LABACC›STA LABTOP›LDA #HIGH LABBAS›ADC LABCNT+1›STA LABACC+1›STA LABTOP+1›LDY #0›LDA ADRBUF;Get the address›STA (LABACC),Y;and store it›INY›LDA ADRBUF+1›STA (LABACC),Y›:ENXITRTS›EPROC›;›;›;*************************›;›;        CLRBUF›;›;*************************›;›; Clears instruction and text output buffers›; and resets their pointers.›;›PROC›CLRBUFLDA #' '›LDX #35›:LP1STA LINEBF,X›DEX›BPL :LP1›LDA #0›LDX #7›:LP2STA INSBUF,X›DEX›BPL :LP2›STA TEXCNT›STA INSPTR›STA BTFLG›RTS›EPROC›;›;›;*********************›;›;       TEXOUT›;›;*********************›;›; Converts contents of INSBUF to a text›; pseudo-op and outputs it.›;›PROC›TEXOUTLDX #7›LDA #LOW STR3;Pseudo-op›STA STRACC›LDA #HIGH STR3›STA STRACC+1›JSR WRTSTR;Output it›LDX #7   ;Find end›:LP0INX›CPX #$D›BNE :OK›LDA #' '   ;Too long, truncate›STA LINEBF,X›INX›LDY #0›JMP :LP1›:OKLDA LINEBF,X›CMP #' '›BNE :LP0›INX›LDY #0›:LP1LDA #'$'›STA LINEBF,X›INX›LDA INSBUF,Y›JSR WRTHEX›LDA #','›STA LINEBF,X›INX›INY›DEC TEXCNT;Any text left?›BNE :LP1;Yes, go back›DEX   ;Back up one›LDA #EOL;to replace final comma›STA LINEBF,X›JSR RECOUT;Output it›JSR CLRBUF;Clear buffers›RTS›EPROC›;›;*********************›;›;       WRTSTR›;›;*********************›;›; Writes a string to the text output buffer.›;›; Enter STRACC(2)=pointer to start of string›;       First byte of string=length›;X=pointer to start point in output buffer›;›; No exit parameters.›;›PROC›WRTSTRLDY #0›LDA (STRACC),Y;Get string length›STA STRLEN›:LP1INY›LDA (STRACC),Y;Get string byte›STA LINEBF,X;Output it›INX›DEC STRLEN;Any left?›BNE :LP1;Yes, go back›RTS;No, done›EPROC›;›;********************›;›;       WRTHEX›;›;********************›;›; Writes a hex number to the output buffer in ASCII form.›;›; Enter Acc=hex byte›;X=pointer to start point in buffer›;›; Exit  X=pointer to next byte in buffer›;›WRTHEXPHA;Save byte›LSR A›LSR A›LSR A›LSR A  ;Get high nibble›JSR NIBASC;Convert to ASCII›STA LINEBF,X;Output it›INX›PLA;Recover byte›AND #$0F;Get lo nibble›JSR NIBASC;Convert to ASCII›STA LINEBF,X;Output it›INX›RTS›;›;********************›;›;       NIBASC›;›;********************›;›; Converts a hex nibble to an ASCII chracter.›;›; Enter Acc=hex nibble›;›; Exit  Acc=ASCII byte›;›PROC›NIBASCCLC›ADC #$30›CMP #$3A›BCC :NOADD›CLC›ADC #$07›:NOADDRTS›EPROC›;›;›;********************›;›;       CLRSEC›;›;********************›;›; Subroutine to clear active sector map›;›PROC›CLRSECLDA #0›LDX #$59;90 bytes to clear›:LP1STA SECMAP,X;Clear a byte›DEX›BPL :LP1›RTS›EPROC›;›;›;********************›;›;       CLRLAB›;›;********************›;›CLRLABLDA #0›LDX #127›:LP1STA LABMAP,X›DEX›BPL :LP1›RTS›EPROC›;›;›;********************›;›;      MAPACC›;›;********************›;›; Subroutine to access active sector/referenced label maps›;›; Enter X,Y=sector number (lo,hi)›; Exit  X=byte number in map›;Y=bit number in byte›;›MAPACCLDA #0›STA TEMP+1;Clear bit number›STX TEMP;Sector nr (lo)›TYA;Sector nr (hi)›LDX #3;Divide-by-8 routine›MAPAC1LSR A›ROR TEMP›ROR TEMP+1›DEX›BNE MAPAC1›;›; Now we have byte number (=sec/8) in TEMP›;›LDX #5;Divide-by-32 routine›MAPAC2LSR TEMP+1›DEX›BNE MAPAC2›;›; Now we have bit number in TEMP+1›;›LDX TEMP›LDY TEMP+1›RTS›;›;›;*********************›;›;       RDORWR›;›;*********************›;›; Subroutine to determine whether a system label is›; accessed by a read or write instruction. Used in›; selecting the proper system label for›; hardware locations.›;›; Enter INSBUF=opcode oc current instruction›; ExitZ bit=set for write access›;      clear for read access›;›PROC›RDORWRLDA INSBUF;Get opcode›AND #%11100111›CMP #%10000110›BEQ :WRXIT›CMP #%10000100›BEQ :WRXIT›AND #%11100011›CMP #%10000001›BEQ :WRXIT›LDA #1›RTS›:WRXITLDA #0›RTS›EPROC›;›;›;**********************›;›;        ADRCOM›;›;**********************›;›; Writes a comment into LINEBF indicating the›; address referenced by a label.›;›; Enter ADRBUF(2) contains the address›;X=LINEBF offset to start of comment›;›; Exit  X=offset to next available output byte›;›PROC›ADRCOMLDA COMENT›BEQ :EXIT›LDA #' '›STA LINEBF,X›INX›LDA #';'›STA LINEBF,X›INX›LDA #'$'›STA LINEBF,X›INX›LDY #1›:LPLDA ADRBUF,Y›JSR WRTHEX›DEY›BPL :LP›:EXITRTS›EPROC›;›;›;**********************›;›;        RELADR›;›;**********************›;›; Subroutine to compute the absolute address referenced›; by a branch instruction.›;›; Enter STAR(2)=current location counter›;        (address of first byte after instruction)›;ADRBUF=branch displacement›;›; Exit  ADRBUF(2)=asolute address›;›PROC›RELADRLDA #0›STA ADRBUF+1›LDA ADRBUF;Forward branch?›BPL :FWD;Yes, go on›LDA #$FF;No, fill out displacement›STA ADRBUF+1›:FWDCLC;Add disp to addr›LDA ADRBUF›ADC STAR›STA ADRBUF›LDA ADRBUF+1›ADC STAR+1›STA ADRBUF+1›RTS›EPROC›;›;›;***********************›;›;         LABMSG›;›;***********************›;›; Subroutine to output a screen message to›; indicate label creation in progress.›;›; No parameters›;›LABMSGLDX #0›LDA #PUTCHR›STA ICCOM,X›LDA MSG15L›STA ICBLL,X›STX ICBLH›LDA #LOW MSG15›STA ICBAL,X›LDA #HIGH MSG15›STA ICBAH,X›JSR CIOV›RTS›;›;**********************›;›;        LINADR›;›;**********************›;›; Subroutine to output address of the current›; instruction line to the screen and (if selected)›; the printer.›;›; Enter STAR(2)=line address›;›; No exit parameters.›;›PROC›LINADRLDX #0;Index to LABUF›LDY #1›:LP0LDA STAR,Y›LSR A›LSR A›LSR A›LSR A›JSR NIBASC›STA LABUF,X›INX›LDA STAR,Y›AND #$0F›JSR NIBASC›STA LABUF,X›INX›DEY›BPL :LP0›LDA #' '›STA LABUF,X›LDX #0›JSR CIOLA;Output address to E:›LDA PROPT;Print?›AND PROPEN›BEQ :EXIT;No›LDX #$30;Yes›JSR CIOLA›BPL :EXIT›LDA #$FF›STA FREEZE›:EXITRTS›CIOLALDA #PUTCHR›STA ICCOM,X›LDA #5›STA ICBLL,X›LDA #0›STA ICBLH,X›LDA #LOW LABUF›STA ICBAL,X›LDA #HIGH LABUF›STA ICBAH,X›JSR CIOV›RTS›EPROC›;›