SRC ALUTIL ASSEM BASIC BUG ERROR GCAS +++++ TITL 'ALUTIL' IDT 'ALUTIL' DEBUG EQU 0 0 FOR PRODUCTION, 1 FOR DEBUGGER *==========================================================* * * This file contains the assembly language utilities. * They include the VDP access routines, the DSR link * routine, the linking loader, and the XML link * routine. * * NOTE: BSS INSTRUCTIONS CANNOT BE USED IN THIS * PROGRAM IN ORDER TO LOAD PROPERLY INTO GROM. * *** SYSTEM EQUATES * SCNKEY EQU >000E ASMIF DEBUG SET EQU >00EC ASMELS SET EQU >00CE ASMEND XMLTAB EQU >0CFA XML TABLES (BASE) ERRCOD EQU >8322 FLAG2 EQU >8349 FAC EQU >834A FAC6 EQU >8350 SCLEN EQU >8355 SCNAME EQU >8356 ARG EQU >835C SUBSTK EQU >8373 CRULST EQU >83D0 SADDR EQU >83D2 GPLWS EQU >83E0 GPL/EXTENDED BASIC WORKSPACE * VDPRD EQU >8800 VDP read data address VDPWD EQU >8C00 VDP write data address VDPWA EQU >8C02 VDP write address address * *** XML vectors * AORG >2000-4 DATA 8,>2000 Length and destination of XMLs DATA >A55A DATA NAMLNK DATA TGOBLD DATA CIF * AORG >2022-4 DATA UTLEND-UTLTAB,>2022 Length and destination * *** Storage variables - THESE LOCATIONS MUST REMAIN FIXED * UTLTAB EQU $ ENTADD DATA 0 Default entry address FSTHI DATA >A000 First free address in high memory ASMIF DEBUG LSTHI DATA >FBFF Last free address in high memory ASMELS LSTHI DATA >FFD7 Last free address in high memory ASMEND FSTLOW DATA UTLEND First free address in low memory LSTLOW DATA PREDEF Last free address in low memory CHKSAV DATA 0 Save checksum FLGPTR DATA 0 Pointer to flag byte in PAB SVGPRT DATA 0 Save GPL return address SAVCRU DATA 0 CRU address of peripheral SAVENT DATA 0 Entry address of DSR SAVLEN DATA 0 Save device name length SAVPAB DATA 0 Ptr into device name in PAB SAVVER DATA 0 Version number of DSR RECORD EQU $ 80 byte record buffer DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 NAMBUF DATA 0,0,0,0 * *** General utility workspace registers (Overlaps next WS) UTILWS DATA 0,0,0 R2LB EQU UTILWS+5 * *** DSR link routine workspace registers (Overlaps prev. WS) DLNKWS DATA 0,0,0,0,0 TYPE DATA 0,0,0,0,0,0,0,0,0,0,0 * *** User program workspace registers USRWSP DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 * *** Linking loader workspace registers LDRWSP EQU $ DATA 0 0 VDP address LR0LB EQU $-1 DATA 0 1 Value or CPU address of value DATA 0 2 Byte count DATA 0 3 LR3LB EQU $-1 DATA 0 4 DATA 0 5 Load bias DATA 0 6 DATA 0 7 Program counter DATA 0 8 Checksum DATA 0 9 Counter DATA 0 10 Save return addresses DATA 0 11 DATA 0 12 Calling flags DATA 0 13 Calling workspace pointer DATA 0 14 Calling program counter DATA 0 15 Calling status value * *** Data * C100 DATA 100 H20 EQU $ H2000 DATA >2000 DECMAL TEXT '.' HAA BYTE >AA * *** Utility BLWP vectors * GPLLNK DATA UTILWS,GLENTR Link to GROM routines XMLLNK DATA UTILWS,XMLENT Link to ROM routines KSCAN DATA UTILWS,KSENTR Keyboard scan VSBW DATA UTILWS,VSBWEN VDP single byte write VMBW DATA UTILWS,VMBWEN VDP multiple byte write VSBR DATA UTILWS,VSBREN VDP single byte read VMBR DATA UTILWS,VMBREN VDP multiple byte read VWTR DATA UTILWS,VWTREN VDP write to register DSRLNK DATA DLNKWS,DLENTR Link to device service routine LOADER DATA LDRWSP,LDENTR Tagged object loader * * * * NAME LINK ROUTINE * * ALC ROUTINE NAME IN FAC * NAMLNK MOV R11,@SVGPRT Save return to GPL interpreter MOVB @FLAG2,R1 Get some flags COC @H2000,R1 Check "RETURN FROM GPL" flag JEQ RTFGPL Yes, this is a return from GPL MOV @FAC6,R0 Take default entry address? JEQ DFLTEN Yes BL @CHKREF Check for unresolved references JMP ERROR ERROR RETURN NAML10 CI R1,PREDEF Are there any user defined labels? JEQ NAMERR No, so error off ** Compare next label MOV R1,R0 Pointer into DEF/REF table LI R2,FAC Pointer to referenced label C *R0+,*R2+ Compare first two bytes JNE NAML20 Mismatch, bail out C *R0+,*R2+ Compare next two bytes JNE NAML20 Mismatch, bail out C *R0+,*R2+ Compare last two bytes JNE NAML20 Mismatch, bail out MOV *R0,@ENTADD Save as default entry for rerun DFLTEN LWPI USRWSP Select user's workspace MOV @ENTADD,R0 Fetch entry address JEQ NAMERR Error, no entry address specified BL *R0 Enter the program LWPI GPLWS Restore GPL workspace MOV @SVGPRT,R11 Restore RTN addr to GPL interp RT Return to GPL interpreter NAML20 AI R1,8 Move on to next DEF/REF table entry JMP NAML10 * ERRSNF EQU >0F00 NAMERR LI R0,ERRSNF Program not found * ERROR MOVB R0,@ERRCOD LWPI GPLWS B @SET * *** Return to assembly language from GPL * RTFGPL SZCB @H20,@FLAG2 Reset GPL flag LWPI UTILWS Select utility workspace RTWP Return to calling AL routine * * LINK TO SYSTEM XML UTILITIES * XMLENT MOV *R14+,@GPLWS+2 Get argument LWPI GPLWS Select GPL workspace MOV R11,@UTILWS+22 Save GPL return address MOV R1,R2 Make a copy of argument CI R1,>8000 Direct address in ALC? JH XML30 We have the address SRL R1,12 SLA R1,1 SLA R2,4 SRL R2,11 A @XMLTAB(R1),R2 MOV *R2,R2 XML30 BL *R2 LWPI UTILWS GET BACK TO RIGHT WS MOV R11,@GPLWS+22 Restore GPL return address RTWP * *** Link to GPL utilities * GLENTR MOVB @SUBSTK,R1 Fetch GPL subroutine stack ptr SRL R1,8 Make it an index MOV *R14+,@>8304(R1) Store routine address 4 bytes * above current stack pointer SOCB @H20,@FLAG2 Set GPL flag LWPI GPLWS Select GPL workspace MOV @SVGPRT,R11 Restore return addr to GPL RT Return to GPL * * KEYBOARD SCAN * KSENTR LWPI GPLWS MOV R11,@UTILWS+22 Save GPL return address BL @SCNKEY LWPI UTILWS MOV R11,@GPLWS+22 Restore GPL return address RTWP * ** VDP single byte write * VSBWEN BL @WVDPWA Write out address MOVB @2(R13),@VDPWD Write data RTWP Return to calling program * ** VDP multiple byte write * VMBWEN BL @WVDPWA Write out address VWTMOR MOVB *R1+,@VDPWD Write a byte DEC R2 Decrement byte count JNE VWTMOR More to write? RTWP Return to calling Program * ** VDP single byte read * VSBREN BL @WVDPRA Write out address MOVB @VDPRD,@2(R13) Read data RTWP Return to calling program * ** VDP multiple byte read * VMBREN BL @WVDPRA Write out address VRDMOR MOVB @VDPRD,*R1+ Read a byte DEC R2 Decrement byte count JNE VRDMOR More to read? RTWP Return to calling program * ** VDP write to register * VWTREN MOV *R13,R1 Get register number and value MOVB @1(R13),@VDPWA Write out value ORI R1,>8000 Set for register write MOVB R1,@VDPWA Write out register number RTWP Return to calling program * ** Set up to write to VDP * WVDPWA LI R1,>4000 JMP WVDPAD * ** Set up to read VDP * WVDPRA CLR R1 * ** Write VDP address * WVDPAD MOV *R13,R2 Get VDP address MOVB @R2LB,@VDPWA Write low byte of address SOC R1,R2 Properly adjust VDP write bit MOVB R2,@VDPWA Write high byte of address MOV @2(R13),R1 Get CPU RAM address MOV @4(R13),R2 Get byte count RT Return to calling routine * **** ** * R0LB EQU >83E1 R1LB EQU >83E3 R3LB EQU >83E7 ************************************************************ * * * CIF - Convert integer to floating * * Assumes that the value in the FAC is * * an integer and converts it into an 8-byte * * floating point value * * * ************************************************************ CIF LI R4,FAC Will convert into the FAC MOV *R4,R0 Get integer into register MOV R4,R6 Copy ptr to FAC to clear it CLR *R6+ Clear FAC,FAC+1 CLR *R6+ IN CASE HAD A STRING IN FAC MOV R0,R5 IS INTEGER EQUAL TO ZERO? JEQ CIFRT YES - ZERO RESULT AND RETURN ABS R0 GET ABS VALUE OF ARG LI R3,>40 GET EXPONENT BIAS CLR *R6+ CLEAR WORDS IN RESULT THAT CLR *R6 MIGHT NOT GET A VALUE CI R0,100 IS INTEGER < 100? JL CIF02 YES-JUST PUT IN 1ST FRACTION * PART CI R0,10000 NO-IS ARG < 100^2? JL CIF01 YES-JUST 1 DIVISION NECESSARY * NO - 2 DIVISIONS ARE NECESSARY INC R3 ADD 1 TO EXPONENT FOR 1ST DIV MOV R0,R1 PUT # IN LOW ORDER WORD FOR * THE DIVIDE CLR R0 CLEAR HIGH ORDER WORD FOR THE * DIVIDE DIV @C100,R0 DIVIDE BY THE RADIX MOVB @R1LB,3(R4) MOVE THE RADIX DIGIT IN CIF01 INC R3 ADD 1 TO EXPONENT FOR DIVIDE MOV R0,R1 PUT IN LOW ORDER FOR DIVIDE CLR R0 CLEAR HIGH ORDER FOR DIVIDE DIV @C100,R0 DIVIDE BY THE RADIX MOVB @R1LB,2(R4) PUT NEXT RADIX DIGIT IN CIF02 MOVB @R0LB,1(R4) PUT HIGHEST ORDER RADIX DIGIT * IN MOVB @R3LB,*R4 PUT EXPONENT IN INV R5 IS RESULT POSITIVE? JLT CIFRT YES - SIGN IS CORRECT NEG *R4 NO - MAKE IT NEGATIVE CIFRT RT * *** Link to device service routine * DLENTR MOV *R14+,R5 Fetch program type for link SZCB @H20,R15 Reset equal bit MOV @SCNAME,R0 Fetch pointer into PAB MOV R0,R9 Save pointer AI R9,-8 Adjust pointer to flag byte BLWP @VSBR Read device name length MOVB R1,R3 Store it elsewhere SRL R3,8 Make it a word value SETO R4 Initialize a counter LI R2,NAMBUF Point to NAMBUF LNK$LP INC R0 Point to next char of name INC R4 Increment character counter C R4,R3 End of name? JEQ LNK$LN Yes BLWP @VSBR Read current character MOVB R1,*R2+ Move it to NAMBUF CB R1,@DECMAL Is it a decimal point? JNE LNK$LP No LNK$LN MOV R4,R4 Is name length zero? JEQ LNKERR Yes, error CI R4,7 Is name length > 7? JGT LNKERR Yes, error CLR @CRULST MOV R4,@SCLEN-1 Store name length for search MOV R4,@SAVLEN Save device name length INC R4 Adjust it A R4,@SCNAME Point to position after name MOV @SCNAME,@SAVPAB Save pointer into device name * *** Search ROM CROM GROM for DSR * SROM LWPI GPLWS Use GPL workspace to search CLR R1 Version found of DSR etc. LI R12,>0F00 Start over again NOROM MOV R12,R12 Anything to turn off JEQ NOOFF No SBZ 0 Yes, turn it off NOOFF AI R12,>0100 Next ROM'S turn on CLR @CRULST Clear in case we're finished CI R12,>2000 At the end JEQ NODSR No more ROMs to turn on MOV R12,@CRULST Save address of next CRU SBO 0 Turn on ROM LI R2,>4000 Start at beginning CB *R2,@HAA Is it a valid ROM? JNE NOROM No A @TYPE,R2 Go to first pointer JMP SGO2 SGO MOV @SADDR,R2 Continue where we left off SBO 0 Turn ROM back on SGO2 MOV *R2,R2 Is address a zero JEQ NOROM Yes, no program to look at MOV R2,@SADDR Remember where we go next INCT R2 Go to entry point MOV *R2+,R9 Get entry address * *** See if name matches * MOVB @SCLEN,R5 Get length as counter JEQ NAME2 Zero length, don't do match CB R5,*R2+ Does length match? JNE SGO No SRL R5,8 Move to right place LI R6,NAMBUF Point to NAMBUF NAME1 CB *R6+,*R2+ Is character correct? JNE SGO No DEC R5 More to look at? JNE NAME1 Yes NAME2 INC R1 Next version found MOV R1,@SAVVER Save version number MOV R9,@SAVENT Save entry address MOV R12,@SAVCRU Save CRU address BL *R9 Match, call subroutine JMP SGO Not right version SBZ 0 Turn off ROM LWPI DLNKWS Select DSRLNK workspace MOV R9,R0 Point to flag byte in PAB BLWP @VSBR Read flag byte SRL R1,13 Just want the error flags JNE IOERR Error! RTWP * *** Error handling * NODSR LWPI DLNKWS Select DSRLNK workspace LNKERR CLR R1 Clear the error flags IOERR SWPB R1 MOVB R1,*R13 Store error flags in calling R0 SOCB @H20,R15 Indicate an error occured RTWP Return to caller * *** Entry to tagged object loader from GPL * TGOBLD MOV R11,@SVGPRT Save return address to interpreter LWPI USRWSP Select user's workspace BLWP @LOADER Call the tagged object loader LWPI GPLWS Return to GPL workspace JEQ LODERR Error during load? MOV @SVGPRT,R11 Restore rtn address to interpreter RT Return to calling program LODERR MOVB @USRWSP,@ERRCOD Store error code B @SET Return to GPL with condition set *==========================================================* * * T A G G E D O B J E C T L O A D E R * * *** Loader error codes * *ERRLIO 0-7 I/O error during load ERRMO EQU 8*256 Memory overflow ERRTAG EQU 10*256 Illegal tag ERRCS EQU 11*256 Checksum error ERRDDF EQU 12*256 Duplicate definition ERRURR EQU 13*256 Unresolved reference * *** Main program segment * LDENTR CLR @ENTADD Clear entry address buffer SZCB @H20,R15 Reset equal status bit MOV @SCNAME,R0 Fetch pointer into PAB BLWP @DSRLNK Open the file DATA 8 Linking to a DSR JEQ LDERR Loader I/O error AI R0,-9 Point to I/O opcode in PAB LI R1,>200 Load a READ opcode BLWP @VSBW Write opcode in PAB INC R0 Point to flag byte in PAB MOV R0,@FLGPTR Save pointer MOV @FSTHI,R7 Initialize program counter MOV R7,R5 Initialize load bias CLR R12 Assume not compressed object BL @GETREC Read 1st record and fetch 1st byte CI R3,1 Compressed object format? JNE DCD No, so continue INC R12 Yes, so indicate compressed format CLR R3 Process as '0' tag JMP COMP Don't decode since not ASCII * *** Tag processors * JUMP EQU $ ** CHKF CI R3,'F' End of record? JNE DCD No, so decode tag ** TAGF CLR R2 Yes, get a new record * NXTTAG EQU $ * ** Ignore checksum TAG8 BL @GETBYT Fetch a byte CI R3,':' End of file? JNE CHKF Yes * *** End of load operation MOV @FLGPTR,R0 Fetch pointer into PAB DEC R0 Point to I/O opcode position in PAB LI R1,>100 Load a CLOSE opcode BLWP @VSBW Write opcode to PAB BL @GETREC Go close file MOV @ENTADD,R0 Immediate execution? JEQ LDRTN No, just return to caller BL @CHKREF Yes, check for unresolved reference JMP LDERR ERROR BRANCH ONLY MOV R14,@22(R13) Move rtn address into caller's R11 MOV @ENTADD,R14 Write execution addr over saved PC LDRTN RTWP Return into loaded modulee ** LDERR MOVB R0,*R13 Place error code in calling R0 SOCB @H20,R15 Set equal bit to indicate error RTWP Return to caller ** DCD BL @DECODE Decode ASCII tag COMP CLR R4 Clean up the jump index MOVB @TAGTBL(R3),R4 Fetch displacement from table SRL R4,7 Right justify and MPY by 2 MOV R8,@CHKSAV Save checksum in case of '7' tag BL @DCDF1 Decode field 1 following tag B @JUMP(R4) Jump to appropriate tag handler * ** PSEG length and module name TAG0 INC R0 Make sure length ANDI R0,>FFFE is an even value MOV @FSTHI,R4 Get first free addr in high memory A R0,R4 Add in current module length JOC TRYLOW Not enough memory in high end C R4,@LSTHI Enough room in high memory? JH TRYLOW No, try the low memory MOV @FSTHI,R5 Set new load bias MOV R4,@FSTHI Set new first high memory pointer JMP SETPC Go set program counter TRYLOW MOV @FSTLOW,R4 Get first free addr in low memory A R0,R4 Add in current module length C R4,@LSTLOW Enough room in low memory? JHE MEMOVF No, so error off MOV @FSTLOW,R5 Set new load bias MOV R4,@FSTLOW Set new first low memory pointer SETPC MOV R5,R7 Set new program counter * ** TAGI LI R9,8 Prepare to skip 8 character symbol SKIP BL @GETBYT Read a byte from record DEC R9 Decrement count JNE SKIP More to get? JMP NXTTAG Continue to next tag ** MEMOVF LI R0,ERRMO Indicate memory overflow JMP LDERR Return error to calling program * ** Relocatable entry point TAG2 A R5,R0 Add load bias to entry address * ** Absolute entry point TAG1 MOV R0,@ENTADD Save entry address JMP NXTTAG Continue to next tag * ** Check the checksum TAG7 A R0,@CHKSAV Add checksum to accumulated value JEQ NXTTAG If correct, go to next tag LI R0,ERRCS Inidicate checksum error JMP LDERR Return error to calling program * ** Relocatable load address TAGA A R5,R0 Add bias to relocatable address * ** Absolute load address TAG9 MOV R0,R7 Move new load address into PC JMP NXTTAG Continue to next tag * ** Relocatable data TAGC A R5,R0 Add bias to relocatable data * ** Absolute data TAGB MOVB R0,*R7+ Move byte of data into program MOVB @LR0LB,*R7+ Move byte of data into program JMP NXTTAG Continue to next tag * ** External reference in relocatable code TAG3 A R5,R0 Add load bias to address of ref * ** External reference in absolute code TAG4 BL @PUSH Push external REF on DEF/REF stack MOV R0,R0 Was REFed symbol ever used? JEQ DLTREF No, so delete the REF * Search for corresponding DEF NXTDEF AI R6,-8 Point to next entry C R6,R4 Done yet? JH NXTDE3 No NEG *R4 No DEF, so neg 1st word of symbol NXTTG2 JMP NXTTAG Continue to next tag NXTDE3 C *R4,*R6 Compare first word of symbols JNE NXTDEF If different, move on C @2(R4),@2(R6) Check second word of symbols JNE NXTDEF If different, move on C @4(R4),@4(R6) Check third word of symbols JNE NXTDEF If different, move on * Resolve the REF MOV @6(R6),R3 Fetch DEFined value into R0 RESREF MOV *R0,R9 Save address of next ref MOV R3,*R0 Store referenced value in code MOV R9,R0 Fetch address of next ref JNE RESREF Not done til next addr = 0000 DLTREF AI R4,8 Delete the REF MOV R4,@LSTLOW Adjust the stack pointer JMP NXTTG2 * ** External definition in relocatable code TAG5 A R5,R0 Add load bias to defined address * ** External definition in absolute code TAG6 BL @PUSH Push DEF on DEF/REF stack * Search for corresponding REFs or duplicate DEFs NXTENT AI R6,-8 Point to next entry NXTEN2 C R6,R4 Done yet? JEQ NXTTG2 Yes MOV *R6,R10 Fetch first word of symbol JGT NXTEN3 Positive indicates DEF, so go on NEG R10 Negate to restore value of REF NXTEN3 C *R4,R10 Compare first word of symbols JNE NXTENT If different, move on C @2(R4),@2(R6) Check second word of symbols JNE NXTENT If different, move on C @4(R4),@4(R6) Check third word of symbols JNE NXTENT If different, move on MOV *R6,R10 REF or DEF? JGT DDFERR Duplicate DEFinition, error off * Resolve the REF MOV @6(R6),R3 Fetch pointer to first REF RESRF2 MOV *R3,R9 Save address of next ref MOV R0,*R3 Store referenced value in code MOV R9,R3 Fetch address of next ref JNE RESRF2 Not done til next addr = 0000 * Delete the REF from the DEF/REF stack MOV R6,R9 S R4,R9 Calculate number of bytes to move MOV R6,R10 AI R10,8 Calculate destination + 1 MOV R6,R3 Fetch source + 1 DELREF DECT R3 Point to next source word DECT R10 Point to next destination word MOV *R3,*R10 Move the word DECT R9 More to move JNE DELREF Yes AI R4,8 Adjust current DEF pointer MOV R4,@LSTLOW Adjust stack pointer JMP NXTEN2 Continue ** DDFERR MOV R4,@2(R13) Return pointer to symbol LI R0,ERRDDF Indicate duplicate definition B @LDERR Return error to calling program MOVFER B @MEMOVF * *** Push DEF or REF on DEF/REF stack * PUSH MOV R11,R10 Save return address LI R9,6 Prepare to push symbol on stack MOV @LSTLOW,R6 Fetch pointer to last DEF/REF AI R6,-8 Assume there is room for another MOV R6,R4 Save pointer for search to follow C R6,@FSTLOW Is there room for this DEF/REF? JL MOVFER No, error off MOV R6,@LSTLOW Yes, store new DEF/REF pointer DEFENT BL @GETBYT Fetch a character of symbol MOVB @LR3LB,*R6+ Move character into DEF/REF table DEC R9 More to move? JNE DEFENT Yes MOV R0,*R6 Move value into table after symbol LI R6,>4000 Point to beginning of DEF/REF stack B *R10 Return to caller * *** Decode field 1 following ASCII tag * DCDF1 MOV R11,R10 Save return address CLR R0 Clear an accumulator MOV R12,R12 Is object compressed? JEQ CMPRS No, go compress it BL @GETBYT Yes, get high byte of data word MOVB @LR3LB,R0 Save high byte BL @GETBYT Get low byte of data word A R3,R0 Add in low byte B *R10 Return to caller CMPRS LI R9,4 Four bytes compress to two CMPRS2 BL @GETBYT Get an ASCII character BL @DECODE Convert it to a hex digit SLA R0,4 Make room for it A R3,R0 Add it in DEC R9 More to compress? JNE CMPRS2 Yes B *R10 Return to caller * *** Convert ASCII character to hexadecimal value * DECODE AI R3,-'0' Subtract an ASCII zero CI R3,>A If it's 0-9, then it's done JL DECRTN Yes AI R3,-7 Otherwise, subtract seven more CI R3,'I'-'0' 'I' tags are the limit JH BADTAG Higher than 'I' gets an error DECRTN RT Return to caller * ** Illegal tags TAGD EQU $ TAGE EQU $ TAGG EQU $ TAGH EQU $ BADTAG LI R0,ERRTAG Indicate illegal tag B @LDERR Return error to calling program * *** Read a record from the file * GETREC LWPI GPLWS Use GPL workspace LI R0,SAVCRU Point to DSR info MOV *R0+,R12 Restore CRU address MOV *R0+,R9 Restore entry address MOV *R0+,@SCLEN-1 Restore device name length MOV *R0+,@SCNAME Restore pointer to filename MOV *R0,R1 Restore version number SBO 0 Select peripheral CB @>4000,@HAA Check for valid ID JNE GIOERR No valid ID, error off BL *R9 Enter DSR JMP GIOERR Bad return, error off SBZ 0 Good return, de-select peripheral LWPI LDRWSP Restore subroutine workspace ptr MOV @FLGPTR,R0 Point to error flags LI R1,LDRWSP+1 Point to destination LI R2,4 Read 4 bytes BLWP @VMBR Get flag byte, buf ptr, and chr cnt SB R0,R0 Clear high byte SRL R0,5 Mask off all but error flags JNE GIOER2 Error off SRL R2,8 Right justify count MOV R1,R0 Point to VDP data buffer LI R1,RECORD Point to CPU data buffer BLWP @VMBR Read the record into CPU RAM CLR R8 Clear the checksum GETBYT DEC R2 Decrement character count JLT GETREC End of record, fetch another one MOVB *R1+,R3 Get a byte and increment buffer ptr SRL R3,8 Right justify A R3,R8 Update checksum RT Return to caller ** GIOERR LWPI LDRWSP Select the proper workspace CLR R0 Clear the error flags GIOER2 SWPB R0 B @LDERR Return error to calling program * *** Check DEF/REF stack for unresolved references * CHKREF LI R1,PREDEF+8 Point to next to last pre-DEF sym CHKRF2 AI R1,-8 Point to next DEF/REF table entry MOV *R1,R0 Is it an unresolved reference? JLT URRERR Yes, so error off C @LSTLOW,R1 End of DEF/REF table? JNE CHKRF2 No, continue INCT R11 SKIP ERROR RETURN RT Return to caller URRERR LI R0,ERRURR Indicate unresolved reference RT Return error to calling program * *** Jump table to tag processors * TAGTBL BYTE (TAG0-JUMP)/2 BYTE (TAG1-JUMP)/2 BYTE (TAG2-JUMP)/2 BYTE (TAG3-JUMP)/2 BYTE (TAG4-JUMP)/2 BYTE (TAG5-JUMP)/2 BYTE (TAG6-JUMP)/2 BYTE (TAG7-JUMP)/2 BYTE (TAG8-JUMP)/2 BYTE (TAG9-JUMP)/2 BYTE (TAGA-JUMP)/2 BYTE (TAGB-JUMP)/2 BYTE (TAGC-JUMP)/2 BYTE (TAGD-JUMP)/2 BYTE (TAGE-JUMP)/2 BYTE (TAGF-JUMP)/2 BYTE (TAGG-JUMP)/2 BYTE (TAGH-JUMP)/2 BYTE (TAGI-JUMP)/2 BYTE 0 Make it even without generating an address tag UTLEND EQU $ End of utilities * *** Machine dependent reference table * PREDEF EQU >4000-(25*8) AORG PREDEF-4 DATA DEFEND-DEFTBL,PREDEF Length and destination DEFTBL DATA 'UT','LT','AB',UTLTAB Start of util var table DATA 'PA','D ',' ',>8300 CPU scratch pad RAM DATA 'GP','LW','S ',>83E0 GPL interp workspace ptr DATA 'SO','UN','D ',>8400 Sound DATA 'VD','PR','D ',>8800 VDP read data DATA 'VD','PS','TA',>8802 VDP read status DATA 'VD','PW','D ',>8C00 VDP write data DATA 'VD','PW','A ',>8C02 VDP write address DATA 'SP','CH','RD',>9000 Speech read DATA 'SP','CH','WT',>9400 Speech write DATA 'GR','MR','D ',>9800 GRAM/GROM read data DATA 'GR','MR','A ',>9802 GRAM/GROM read address DATA 'GR','MW','D ',>9C00 GRAM write data DATA 'GR','MW','A ',>9C02 GRAM/GROM write address DATA 'SC','AN',' ',>000E Keyboard scan routine DATA 'XM','LL','NK',XMLLNK Link to ROM routines DATA 'KS','CA','N ',KSCAN Keyboard scan routine DATA 'VS','BW',' ',VSBW VDP single byte write DATA 'VM','BW',' ',VMBW VDP multiple byte write DATA 'VS','BR',' ',VSBR VDP single byte read DATA 'VM','BR',' ',VMBR VDP multiple byte read DATA 'VW','TR',' ',VWTR VDP write to register DATA 'DS','RL','NK',DSRLNK Link to DSRs DATA 'LO','AD','ER',LOADER Tagged object loader DATA 'GP','LL','NK',GPLLNK Link to GROM routines DEFEND EQU $ END +++++ ****** TITLE ASSEM ************************************************************ * July 17, 1981 Author S.Endo * ************************************************************ * ASSEMBLER * ************************************************************ ***** OPTLN EQU >20D2-OFFSET Option line for assembler ****** ASSEM ALL SPACE UNLM FMT XPT=2,YPT=2,':* ASSEMBLER *:' LISTM * DCLR @FLAG Clear all flags. ST >7E,@SUBSTK Reset subroutine stack. SB @FLAG,ASRC Now we are in assembler * $IF @IDCODE .DEQ. >AA55 GOTO ASM10 It's already loaded UNLM FMT 19<,1^,':LOAD ASSEMBLER(Y/N)? :' LISTM * CALL YORN Get response. yes or no. $IF @KEY .EQ. BACK GOTO START Back key or :n: key $IF @KEY .EQ. :N: GOTO START will take you back to menu. ***** * LOAD ASSEMBLER HERE ***** CALL DOWNLD Down load assembler DATA #ASNAME CALL DOWN10 Down load it. ************ * Give additional space for assembler -- COPY needs this ************ ASM10 DST >0116,RAM(BUF4) DST BUF4,@FAC12 ST 4,@FAC2 Number of files disk DSR handles CALL DSRLNK Call files DATA 10 ************ * START OPENING FILES HERE ************ Open a source file *********** UNLM FMT XPT=2,YPT=4,':SOURCE FILE NAME? :' LISTM DST #PAB1,@SREF Put source PAB address. DST >0C2,@LOC Get loc for source file name. CALL DSR2 Prepare PAB area * DST BUF1,RAM(BUF(SREF)) Source buffer address * Next subroutine tries to open with fix and var format * ST 04,RAM(FLG(SREF)) Disp, fixed, seq, input * ST >14,RAM(FLG(SREF)) Disp, variable, seq, input CALL FIXVAR Open it!!! * ************ Open an object file *********** UNLM FMT XPT=2,YPT=8,':OBJECT FILE NAME?:' LISTM DST #PAB2,@SREF Put obj PAB address DST >142,@LOC Set file name pointer. CALL DSR2 Prepare PAB area * ST 00,RAM(FLG(SREF)) Open with update mode DST BUF2,RAM(BUF(SREF)) Buffer address. CALL DSR3 Open output file. SB @FLAG,AOBJ Flag for obj file open * ************ Open a list file ********** UNLM FMT XPT=2,YPT=12,':LIST FILE NAME?:' LISTM DST #PAB3,@SREF Put list PAB address SB @FLAG,NOTHIN No file name is OK. DST >1C2,@LOC Set pointer to name CALL DSR2 Prepare PAB area. * $IF @FAC6 .DEQ. 0 GOTO ASKOPT No list file. Skip. ST >12,RAM(FLG(SREF)) Open with output mode DST BUF3,RAM(BUF(SREF)) Buffer address. CALL DSR3 Open output file . SB @FLAG,ALST List file is open * ********** Ask for options *********** ASKOPT * Clean up OPTLN beforehand ?????? FMT XPT=2,YPT=16,':OPTIONS?:' DST >242,@LOC Specify cursor location CALL NAME RB @FLAG,NOTHIN No input line was OK so far. * Option is transfered to ERAM $IF @FAC6 .DEQ. 0 THEN No option. It's OK DST @LOC,@FAC4 $END IF MOVE 15 FROM RAM(@FAC4) TO @OPTLN Move to RAM *** ************ Now assemble !!!!!! ********* *** CALL CLRTOP Clear editor information ALL SPACE XML ASM Assemble the program. BS EMSG Error routine shared with editor ********* Close files before going back to menu ****** * ASMOUT CALL CLRTOP Clear editor information DST PAB1,@SREF Close source file CALL CLOSE DST PAB2,@SREF Close object file CALL CLOSE $IF .BIT(ALST) @FLAG .EQ. 1 THEN DST PAB3,@SREF Close list file CALL CLOSE $END CLR @FLAG ********* CALL CONT Issue message and continue. BR START Go back to menu screen. ******* ******* ****** * DATA AREA ***** UNLM LODMSG DATA :ONE MOMENT PLEASE...: LISTM PAGE ****** **** ***** * Get "yes" or "no" response from keyboard ***** YORN ST CURSOR,@CHRBUF SCAN30 CLR @TIMER EX CB,@CHRBUF $REPEAT Wainting for input. SCAN BS SCAN35 $UNTIL @TIMER .HE. 6 BR SCAN30 SCAN35 $IF @KEY .EQ. BACK GOTO YNEND $IF @KEY .EQ. :Y: GOTO YNEND $IF @KEY .NE. :N: GOTO SCAN30 YNEND ST @KEY,CB Show character on screen. RTN **** *** * PAGE +++++ * TITLE BASIC ************************************************** * Sept 09, 1981 Author S.Endo * ************************************************** * BASIC SUPPORT FUNCTIONS * ************************************************** ***** * This program takes care of interface to BASIC. * Routines callable from console BASIC are listed * in the link list below. ***** ******* ** XML EQUATES *** ****** CFI EQU >12 Convert floating point to integer SYM EQU >13 SMB EQU >14 ASSGNV EQU >15 Assign value to numeric. VPUSH EQU >17 Push to stack VPOP EQU >18 Pop off the stack. PGMCH EQU >1B Advance one character * **** GPL CALLS *** * GETSTR EQU >38 GET ENOUGH SPACE FOR STRING WARN$$ EQU >1A Warning handling routine ERR$$ EQU >1C Error handling routine ****** *** CPU RAM EQUATES *** ***** PC EQU >04 Address pointer BYTE EQU >0C Number of bytes to move OLDS EQU >10 CNT EQU >12 Counter. PCODE EQU >16 ERAM address to store parm information * PARM EQU >200A->8300 PARAMETER COUNT INFORMATION * PGMPTR EQU >2C Program pointer * FREPTR EQU >40 Free space pointer CHAT EQU >42 Character code VSPTR EQU >6E Value stack pointer **** COMMA$ EQU >B3 Token for "," RPAR$ EQU >B6 Token for ")" LPAR$ EQU >B7 Token for "(" STRING EQU >65 String ID byte *********************************************************** ** LINK LIST -- list of callable subprograms * *********************************************************** LINK01 DATA #LINK02,#INIT,4,:INIT: LINK02 DATA #LINK03,#BLOAD,4,:LOAD: LINK03 DATA #LINK04,#BLINK,4,:LINK: LINK04 DATA #LINK05,#PEEK,4,:PEEK: LINK05 DATA #LINK06,#PEEKV,5,:PEEKV: LINK06 DATA #LINK07,#POKEV,5,:POKEV: LINK07 DATA #0,#GETCHR,7,:CHARPAT: *********************************************************** * INIT -- initialization routine * *********************************************************** INIT SB @FLAG,BSC Set BASIC flag on. DADD 5,@PGMPTR Skip name len and name 'INIT' CALL INIT3 Force UTIL load * BR RTBSC2 Go back to BASIC interpreter *** * Routine to load UTIL subroutines *** INIT2 $IF @IDCODE .DNE. >A55A THEN Check if UTIL is there INIT3 CALL CHKRAM Is E-RAM there? ST 3,@FAC Force UTIL load DST ALCODE,@FAC2 INITLP EQU $ MOVE 4 FROM ROM(@FAC2) TO @FAC4 Load utility routine DADD 4,@FAC2 MOVE @FAC4 FROM ROM(@FAC2) TO @->8300(FAC6) DADD @FAC4,@FAC2 DEC @FAC BR INITLP BR CLRTOP Clear editor information and return $END IF RTN *** **** SKIPN CLR @FAC Count size of routine name ST RAM(@PGMPTR),@FAC+1 Copy size DADD @FAC,@PGMPTR Advance pointer to end of name DINC @PGMPTR Advance pointer to char after name XML PGMCH Get next token $IF @CHAT .NE. LPAR$ GOTO ERRIS Has to be "(". XML PGMCH Advance pointer one more time RTN PAGE *** *********************************************************** *** CALL LOAD and POKEV from BASIC program ******** *********************************************************** POKEV SB @FLAG,VFLG Turn on VDP flag BR LDP1 Join LOAD routine BLOAD DCLR @FLAG Delete all flags SB @FLAG,BSC Called from BASIC program. ***** LDP1 CALL SKIPN Skip name first LDP3 PARSE RPAR$ Parse up to ")". ** Process file name if it is a string. ** $IF @FAC2 .EQ. STRING GOTO LDP2 ** Otherwise, it is an absolute address ** XML CFI Convert to integer $IF @FAC10 .EQ. 03 GOTO ERRNTB Check for overflow DST @FAC,@PC Save in ERAM(or VRAM) address pointer LDP4 $IF @CHAT .NE. COMMA$ GOTO RTBSC RETURN TO BASIC. XML PGMCH Skip "," PARSE RPAR$ Parse up to ")" $IF @FAC2 .EQ. STRING THEN No more data? $IF @FAC6 .DEQ. 0 GOTO BEXTLD Null string? BR ERRBA Bad argument $END IF ** Numeric in FAC area XML CFI Convert to integer $IF @FAC10 .EQ. 03 GOTO ERRNTB Overflow error *** $IF .BIT(VFLG) @FLAG .EQ. 1 THEN ST @FAC+1,RAM(@PC) POKE INTO VDP RAM LOCATION $SELSE Poke into CPU RAM . DSUB OFFSET,@PC ST @FAC+1,@0(PC) Store it in ERAM DADD OFFSET,@PC $END IF DINC @PC Increment ERAM address. B LDP4 Continue loop ***** LDP2 $IF @FAC6 .DEQ. 0 GOTO BEXTLD Skip null string. $IF .BIT(VFLG) @FLAG .EQ. 1 GOTO ERRSNM Not for VDP poke. * * Following section prepares PAB area for object file * * DST @FAC6,@BYTE Store actual spec. length DADD PABLEN+80,@BYTE Add in the PAB len. and buffer len. XML VPUSH Push possible temp. string CALL INIT2 make sure Utility is there CALL GETSTR and try to allocate space XML VPOP Restore original string data * * Variable specification * FAC+4,5 Start address of original device spec. * FAC+6,7 LENGTH OF ORIGINAL DEVICE SPECIFICATIO * SREF Location of PAB in VDP memory * BYTE Length of entire PAB, including spec. * CALL CLRPAB Clear the entire PAB CALL COPYNM Copy device name and length ST >60,RAM(SCR(SREF)) Screen offset ST &00000100,RAM(FLG(SREF)) Disp, fixed, seq, input DADD @SREF,@FAC6 Calculate the address of the DADD PABLEN,@FAC6 buffer DST @FAC6,RAM(BUF(SREF)) Store buffer address in PAB BR BENTLD Enter object file Loader **** ******** ******* ** Entry from object file loader CALL LOAD **** ******** ******* BEXTLD EQU $ * $IF @CHAT .NE. COMMA$ GOTO RTBSC Go back to BASIC. XML PGMCH {SKIP COMMA} BR LDP3 {CONTINUE IN MAIN LOOP} ******** PAGE ******** ****** *********************************************************** * PEEK AND PEEKV ROUTINE * *********************************************************** * * FORMAT: * CALL PEEK (address, numeric variable,....) * CALL PEEKV (Address, numeric variable,....) * FUNCTION: * RETURNS THE VALUE AT address IN ERAM INTO * numeric-variable. IF MORE THAN ONE numeric-variable IS * SPECIFIED THEN address IS INCREMENTED AND THE VALUE * IN ERAM AT THE NEW address IS ASSIGNED TO THE NEXT * VARIABLE AND SO ON. * PEEKV SB @FLAG,VFLG VDP FLAG SET BR PEEK0 ENTRY POINT PEEK DCLR @FLAG CLEAR FLAG PEEK0 CALL SKIPN SKIP NAME FIRST * CALL INIT2 CHECK UTIL IS THERE AND LOAD PEEK1 PARSE RPAR$ GET VALUE OF ADDRESS $IF @FAC2 .EQ. STRING GOTO PEEK3 SKIP NULL STRING XML CFI [CONVERT FAC TO INTEGER] $IF @FAC10 .EQ. 03 GOTO ERRNTB [OVERFLOW?] DST @FAC,@PC [SAVE PEEK ADDRESS] $IF @CHAT .NE. COMMA$ GOTO RTBSC [GO BACK TO BASIC? * PEEK2 XML PGMCH SKIP "," $IF @CHAT .EQ. >C7 THEN STRING PARSE RPAR$ GET STRING VALUE $IF @FAC2 .EQ. STRING THEN SKIP NULL STRING PEEK3 $IF @FAC6 .DNE. 0 GOTO ERRSNM SHOULD BE NULL $IF @CHAT .NE. COMMA$ GOTO RTBSC RETURN TO BASIC XML PGMCH SKIP COMMA BR PEEK1 GO BACK TO THE LOOP $END IF $END IF $IF @CHAT .HE. >80 GOTO RTBSC GO BACK TO BASIC? XML SYM GET SYMBOL NAME XML SMB GET VALUE POINTER XML VPUSH SAVE FAC AREA * ** GET VALUE FROM ERAM OR RAM INTO FAC+1 * $IF .BIT(VFLG) @FLAG .EQ. 1 THEN ST RAM(@PC),@ARG+1 GET VALUE FROM VDP RAM $SELSE GET VALUE FROM CPU RAM DSUB OFFSET,@PC TAKE OUT OFFSET ST @0(PC),@ARG+1 MOVE VALUE FROM ERAM DADD OFFSET,@PC $END IF * ** CONVERT INTEGER TO FLOATING INTO FAC AREA * CALL CLRFAC CLEAR FAC AREA FIRST $IF @ARG+1 .EQ. 0 GOTO SKIP IF ZERO ... ST >40,@FAC IF LESS THAN 100 CLR @ARG PREPARE FOR WORD OPERATION DIV 100,@ARG DIVIDE BY 100 ST @ARG,@FAC+1 VALUE IF OVER 100 ST @ARG+1,@FAC+2 Move to the third digit. $IF @FAC+1 .EQ. 0 THEN Value is less than 100 EX @FAC+1,@FAC+2 Move third byte to second $SELSE If over 100 INC @FAC Increment exponent value $END IF * * SKIP XML ASSGNV {ASSIGN TO NUMERIC-VARIABLE} $IF @CHAT .NE. COMMA$ GOTO RTBSC DINC @PC {INC POINTER TO NEXT ERAM ADDRESS} B PEEK2 * ***** PAGE ******************************************** * * * LINK INSTRUCTION : SE September, 1980 * * * ******************************************** * * FORMAT: * * CALL LINK("file-name",parameter1,parameter2,.....) * * LINK ROUTINE READS THE FILE NAME SPECIFIED BY THE USER * AND SAVE THE ADDRESS OF THE NAME FOR LATER USE. * THE FILE WILL BE SEARCHED IN UTILITY CODE LATER ON. * * PARAMETERS ARE PASSED EITHER BY REFERENCE OR BY VALUE. * NUMERIC OR STRING VARIABLES AND NUMERIC OR STRING ARRAYS * ARE PASSED BY REFERENCE AND ALL OTHERS INCLUDING A USER * DEFINED FUNCTION ARE PASSED BY VALUE. * * PARAMETER INFORMATION IS STORED IN ERAM >200A THRU >201A * THAT GIVES A PARAMETER TYPE CODE OF EACH PARAMETER. * CODE 0 .... Numeric expression * CODE 1 .... String expression * CODE 2 .... Numeric variable * CODE 3 .... String variable * CODE 4 .... Numeric array * CODE 5 .... String array * * IF A PARAMETER IS PASSED AS A NUMERIC EXPRESSION ITS * ACTUAL VALUE GETS PUSHDED INTO THE VALUE STACK. * IN CASE OF A STRING EXPRESSION, ITS VALUE STACK CONTAINS * AN ID(>65), POINTER TO THE VALUE SPACE AND ITS LENGTH. * IF A PARAMETER GETS PASSED AS A REFERENCE THE PRODUCT * OF XML SYM AND XML SMB IN THE @FAC AREA GETS PUSHED INTO * STACK. * * AFTER AN ASSEMBLY LANGUAGE SUBPROGRAM IS EXECUTED LINK * ROUTINE WILL POP THE STACK TO GET RID OF PARAMETER * INFORMATION. CONTROL WILL BE TRANSFERED TO THE BASIC * MAIN PROGRAM AFTERWARDS. * **** DATA AREA **** * CPU RAM FREE SPACE USED IN THIS ROUTINE * * FLAG BITS STORED IN LOCATIONS 00 TO >0F **** PAGE **************************************** * CALL LINK program * **************************************** * BLINK SB @FLAG,BSC CALLED FROM BASIC PROGRAM. CALL SKIPN SKIP NAME FIRST CALL CHKRAM Make sure E-RAM is there $IF @IDCODE .DNE. >A55A GOTO ERRPN No program SB @FLAG,BSC Set bit for BASIC flag DST @VSPTR,@OLDS Save VSPTR for later use. PARSE RPAR$ Get the routine name. * Read up to ")". $IF @FAC2 .NE. STRING GOTO ERRSNM Should be a string. $IF @FAC6+1 .H. 6 GOTO ERRBA Should be less than 6 char. XML VPUSH Push to make it semi-permanent. CLR @CNT Initialize parameter counter. DST PARM,@PCODE Set initial address for parmaeter * **************************************** * PARAMETERS get evaluated here * **************************************** PAR01 $IF @CHAT .EQ. RPAR$ GOTO EXE01 No arg. So execute it. $IF @CHAT .NE. COMMA$ GOTO ERRIS Should have a comma. * DST @PGMPTR,@ERRCOD Save text pointer. XML PGMCH Get the character $IF @CHAT .HE. >80 GOTO VAL01 Must be an expression. * $IF @CHAT .EQ. LPAR$ Pass by expression. CALL CLRFAC Clear FAC entry for SYM. XML SYM Read in the symbol table info. * * After XML SYM @FAC area contains a pointer to * symbol table. * * Below statement checks if it is a UDF. $IF .BIT6 RAM(@FAC) .EQ. 1 GOTO VAL01 Pass by value. $IF @CHAT .EQ. COMMA$ GOTO REF01 Pass by reference. $IF @CHAT .EQ. RPAR$ GOTO REF01 Pass by reference. $IF @CHAT .EQ. LPAR$ GOTO ARRAY An array. $IF @CHAT .HE. >80 GOTO VAL01 Pass by value. BR ERRIS * **************************************** * ARRAY case gets checked here * **************************************** * should look like A(,,) etc. * Stack entry for an arry will look like * _________________________________________________________ * | Pointer to |>00 | | Pointer to | | * | symbol table | or | | dim info in | | * | entry |>65 | | real v.s. | | * FAC---------------FAC2--------FAC4----------FAC6--------- * * ARRAY XML PGMCH Get the next character. $IF @CHAT .EQ. RPAR$ GOTO ARRAY2 Pass by reference. $IF @CHAT .EQ. COMMA$ GOTO ARRAY More array information. DDEC @PGMPTR Adjust the pointer. ST LPAR$,@CHAT BR REF01 Pass by reference. * ARRAY2 * * In array cases the symbol table address gets stored * at FAC area, and the pointer to the value space * (dimension info.) goes into FAC4 * XML PGMCH Advance the program pointer. $IF .BIT7 RAM(@FAC) .NE. 1 THEN Test string bit. ST 4,@0(PCODE) Numeric array. $SELSE ST 5,@0(PCODE) String array case. $END IF * * Put the pointer to the value space (dimension info.) * into FAC4. DST @FAC,@FAC4 Array is not shared. DADD 6,@FAC4 Point to value space * BR PUSH * **************************************** * VALUE * * Passing the parameter by value * **************************************** VAL01 DST @ERRCOD,@PGMPTR Restore program pointer. XML PGMCH Skip the first character. PARSE RPAR$ Parsing up to comma. * * After parsing @FAC area contains * its actual numeric value in a numeric case, and the * following information in a string case. * _________________________________________________________ * | >001C | >65 | | Pointer to | Length of | * | or value pointer | | | string | string | * | address | | | | | * FAC----------------FAC2--------FAC4---------FAC6--------- * * $IF @FAC2 .EQ. STRING THEN If it is a string ST 1,@0(PCODE) Store flag for string expression. $SELSE CLR @0(PCODE) Otherwise it is a numeric express . $END IF BR PUSH Push into stack. * **************************************** * REFERENCE * * Passing the parameter by reference * **************************************** * Variables, array element and whole array passing. * * * After SMB @FAC Entry should look like * _________________________________________________________ * | Pointer to | >00 | | Pointer to | | * | symbol table | | | value space | | * | entry | | | | | * FAC---------------FAC2--------FAC4----------FAC6--------- * for a numeric case, and * _________________________________________________________ * | Pointer to | >65 | | Pointer to | String | * | value space | | | string | length | * | entry | | | | | * FAC---------------FAC2--------FAC4----------FAC6--------- * for a string case. * REF01 XML SMB Get the location. $IF @CHAT .HE. >B8 GOTO VAL01 Pass array expression. $IF @FAC2 .EQ. 00 THEN ST 2,@0(PCODE) Must be a numeric variable. $SELSE ST 3,@0(PCODE) Must be a string variable. $END IF * **************************************** * PUSH routine * * Pushes @FAC entry into a value stack* **************************************** PUSH INC @CNT Increment number of parameter. $IF @CNT .H. 16 GOTO ERRBA Too many parameters. DINC @PCODE Increment parm info address * XML VPUSH BR PAR01 Get the next argument. * **************************************** * EXECUTE routine * * Restore file name info and transfer * * control over to ALC * **************************************** EXE01 ST SPACE,@FAC Store blank in the FAC area. MOVE 5 FROM @FAC TO @FAC+1 MOVE 4 FROM RAM(12(OLDS)) TO @TEMP $IF @TEMP+2 .DEQ. 0 GOTO EX10 Do not move 0 bytes. MOVE @TEMP+2 FROM RAM(@TEMP) TO @FAC Move name to FAC. DST @TEMP+2,@FAC6 Copy name length BR EX10 Join execution code. * **************************************** * RETURN to the BASIC main program. * **************************************** NOERR $WHILE @VSPTR .DH. @OLDS XML VPOP Pop the stack. $END WHILE Keep popping till no stack for * RTBSC $IF @CHAT .NE. RPAR$ GOTO ERRIS Check ")". RTBSC2 XML PGMCH Advance to the next character. $IF @CHAT .NE. 00 GOTO ERRIS Check end of statement. CALL RPL Go back to BASIC * **************************************** * SUBROUTINES used in this file. * **************************************** CLRFAC CLR @FAC MOVE 7 FROM @FAC TO @FAC+1 RTN PAGE ******************************************* * * * CHARPAT ROUTINE * * * ******************************************* * * FORMAT: * CALL CHARPAT open ( comma * )* close * FUNCTION: * RETURNS THE CHARACTER DEFINTION PATTERN FOR CHARCTER * NUMBER INTO . * **** TBLPTR EQU >10 Table pointer STRPTR EQU >12 String pointer **** GETCHR CALL SKIPN Skip subroutine name GCHR2 PARSE RPAR$ $IF @FAC2 .EQ. STRING GOTO ERRSNM Can't be a string XML CFI Convert FAC to integer * Note that 32 - 159 char are supported in Console BASIC $IF @FAC10 .EQ. 3 GOTO ERRNTB {range 32 -> 159} $IF @FAC .DLT. #32 GOTO ERRBA " " " $IF @FAC .DGT. #159 GOTO ERRBA " " " DSLL @FAC,3 {8 bytes / entry so multiply by 8 } DST >300,@TBLPTR {Base of character table less 32*8 } DADD @FAC,@TBLPTR {Add in arg offset} DST 16,@BYTE Get a 16 byte string in string space CALL GETSTR DST @SREF,@STRPTR Save pointer to string ST 8,@TEMP4 Loop counter ** GETLP ST RAM(@TBLPTR),@TEMP DSRL @TEMP,4 Shift 4 bits to right. ADD >30,@TEMP Add ASCII "0" $IF @TEMP .LE. >39 GOTO GCHR3 >39=ASCII("9") ADD 7,@TEMP Value "A" -> "F" GCHR3 SRL @TEMP+1,4 Shift 4 bits for next byte. ADD >30,@TEMP+1 Add ASCII "0" $IF @TEMP+1 .LE. >39 GOTO GCHR4 ADD 7,@TEMP+1 Value "A" -> "F" GCHR4 DST @TEMP,RAM(@STRPTR) Now put in RAM DINC @TBLPTR Next byte DINCT @STRPTR Move pointer two bytes DEC @TEMP4 Count down BR GETLP Continue loop * * NOW ASSIGN THE STRING JUST CREATED TO THE STRING * VARIABLE FOLLOWING *** *** *** *** XML PGMCH {SKIP ","} $IF @CHAT .HE. >80 GOTO ERRIS {DON'T ALLOW TOKEN} XML SYM {GET SYMBOL NAME} XML SMB {GET VALUE POINTER} XML VPUSH {SAVE FAC ON STACK FOR ASSGNV} *** $IF @FAC2 .NE. STRING GOTO ERRSNM Must be a string var. DST >001C,@FAC Temp string so use SREF as address DST @SREF,@FAC4 Pointer to string DST 16,@FAC6 String length XML ASSGNV Assign to string variable $IF @CHAT .NE. COMMA$ GOTO RTBSC Finish looping! XML PGMCH Advance pointer. Skip "," BR GCHR2 Repeat the process PAGE ***** *********************************************************** * ERROR BRANCH TABLE FOR LINK ** *********************************************************** * * ERROR MESSAGE EQUATES (msg are in console GROM) * MSG1 EQU >202C Incorrect statement MSG4 EQU >2040 Bad name MSG5 EQU >2049 Memory full MSG6 EQU >2055 Can't continue MSG3 MSG14 MSG7 EQU >2064 Bad value MSG8 EQU >206E Number too big MSG11 EQU >207D String-number missmatch MSG12 EQU >2094 Bad argument MSG13 EQU >20A1 Bad subscript MSG15 EQU >20AF Name conflict MSG2 MSG17 EQU >20BD Can't do that MSGBLN EQU >20D9 Bad line number MSG18 EQU >20F9 For-next error MSG21 EQU >2113 I/O error MSG22 EQU >211D File error MSG23 EQU >2128 Input error MSG24 EQU >2134 Data error MSG19 EQU >213F Line too long * **** ERROR BRANCHES ***** * ERRBSC DECT @SUBSTK Adjust subroutine stack $IF @ERRCOD .L. 8 GOTO ERRDSR I/O error $IF @ERRCOD .HE. >F GOTO ERRORB Do not close the file CALL CLSNO Close the file ERRORB $IF @ERRCOD .H. >21 GOTO ERRUEC Unknown error SUB 8,@ERRCOD CASE @ERRCOD BR ERRMM 8 Memory full BR ERRIS 9 Control char -- not issued BR ERRTAG A Bad tag BR ERRCHK B Checksum error BR ERRDD C Duplicate definition BR ERRUR D Unresolved reference BR ERRIS E No entry address -- not issued BR ERRPN F Program not found BR ERRIS 10 Incorrect statement BR ERRBN 11 Bad name BR ERRCC 12 Can't continue BR ERRBV 13 Bad value BR ERRNTB 14 Number too big BR ERRSNM 15 String-number mismatch BR ERRBA 16 Bad argument BR ERRBS 17 Bad subscript BR ERRNC 18 Name conflict BR ERRCDT 19 Can't do that BR ERRBLN 1A Bad line number BR ERRFNE 1B For-next error BR ERRIOB 1C I/O error BR ERRFE 1D File error BR ERRINP 1E Input error BR ERRDAT 1F Data error BR ERRLTL 20 Line too long BR ERRMM 21 Memory full without * file being open **************************************** * ERROR HANDLING SECTION * **************************************** **** ERRMM CALL ERR$$ * Memory full DATA #MSG5 * ERRTAG CALL ERR$$ * Bad tag DATA #MSGTAG * ERRCHK CALL ERR$$ * Checksum error DATA #MSGCHK * ERRDD CALL ERR$$ * Duplicate definition DATA #MSGDD * ERRUR CALL ERR$$ * Unresolved references DATA #MSGUR * ERRPN CALL ERR$$ * PROGRAM NOT FOUND DATA #MSGPN * ERRIS CALL ERR$$ DATA #MSG1 * Incorrect statement * ERRBN CALL ERR$$ DATA #MSG4 * BAD NAME * ERRCC CALL ERR$$ DATA #MSG6 * Can't continue * ERRBV CALL ERR$$ DATA #MSG7 * BAD VALUE * ERRNTB CALL ERR$$ DATA #MSG8 * NUMBER TOO BIG * ERRSNM CALL ERR$$ DATA #MSG11 * String Number mismatch * ERRBA CALL ERR$$ DATA #MSG12 * BAD ARGUMENT * ERRBS CALL ERR$$ DATA #MSG13 * BAD SUBSCRIPT * ERRNC CALL ERR$$ DATA #MSG15 * NAME CONFLICT * ERRCDT CALL ERR$$ DATA #MSG17 * CAN'T DO THAT * ERRBLN CALL ERR$$ DATA #MSGBLN * Bad line number * ERRFNE CALL ERR$$ DATA #MSG18 * For-next error * ERRFE CALL ERR$$ DATA #MSG22 * File error * ERRINP CALL ERR$$ DATA #MSG23 * Input error * ERRDAT CALL ERR$$ DATA #MSG24 * Data error * ERRLTL CALL ERR$$ DATA #MSG19 * Line too long * ERRRMB CALL ERR$$ DATA #MSGRAM * No memory expansion * ERRUEC CALL ERR$$ DATA #MSGUEC * Unknown error code * ******** *********************************************************** * ERRDSR -- routine to handle IO errors for BASIC * *********************************************************** ERRDSR DST @SREF,@TEMP4 Copy PAB address DSUB 04,@TEMP4 BASIC assumes offset by 4 * ERRIOB CALL ERR$$ DATA #MSG21 * I/O error ** ******** ******** **** Error messages ******* BASE 0,0,0,0,0,0,>60 UNLM MSGTAG DATA 11,:ILLEGAL TAG: MSGCHK DATA 14,:CHECKSUM ERROR: MSGDD DATA 20,:DUPLICATE DEFINITION: MSGUR DATA 20,:UNRESOLVED REFERENCE: MSGPN DATA 17,:PROGRAM NOT FOUND: MSGRAM DATA 19,:NO MEMORY EXPANSION: MSGUEC DATA 18,:UNKNOWN ERROR CODE: LISTM ALCODE EQU >7000 * END PAGE +++++ **** **** * BUG FILE - bugs corrected on September 4, 1981 * **** **** BASE 0,>800,>380,>300,>400,>780,0 **** * Bug 1 - copy right character does not show on screen * line 189 in the file USER, USERS **** BUG1 CALL CHKRAM Test if RAM expansion exists. MOVE 8 FROM ROM(#COPY) TO CHAR(>A) load copy right char. RTN * COPY DATA >3C,>42,>99,>A1,>A1,>99,>42,>3C **** * Bug 2 - ASSEMBLY LANGUAGE instead of EDITOR/ASSEMBLER * is shown on the first screen. * line 200 in the file USER, USERS * This bug is fixed in the USER file **** **** * Bug 3 - I/O error occurred in BASIC closes the file * before the error code is read in. * line 610 in the file BASIC * This bug has been fixed in the BASIC file **** END +++++ *** TITLE ERROR ************************************************************ * July 17, 1981 Author S.Endo * ************************************************************ * ERROR HANDLING ROUTINES * ************************************************************ * * * All GPL errors are handled in this section * ************************************************************ * EMSG -- error message retured from assembly language * * utility program such as ASSM, EDIT, ALUTIL * ******* EMSG1 CALL COLOR Special entry for editor EMSG CALL FIX Fix screen and branch BASIC error $IF @ERRCOD .L. 8 GOTO ERRIO SUB 8,@ERRCOD $IF @ERRCOD .H. 5 GOTO RETURN No error CALL CLSALL Close all files. No error checks. CASE @ERRCOD BR ERRMEM Code 8: Memory full BR WRNCHR Code 9: Control character BR BADTAG Code A: Bad tag BR ERRCSM Code B: Checksum error BR ERRDDF Code C: Duplicate definition BR ERRURR Code D: Unresolved references * RETURN $IF .BIT(ASRC) @FLAG .EQ. 1 GOTO ASMOUT $IF .BIT(LD) @FLAG2 .EQ. 1 GOTO LOAD CALL CLSNO BR EDIT Go back to editor ************************************************************ * ERRXML -- Error returned from user's program * * or program file loaded by selection 5 * ************************************************************ ERRXML CALL FIX Fix screen and branch to BASIC error CALL COLOR Reload screen * The following error can only be used by user execution $IF @ERRCOD .EQ. >0F THEN ERRPR2 CALL ERROR :Program not found: DATA #PRGNF BR ERRNM2 Clear msg. Go back for new input. $END IF CALL ERROR :XML error: DATA #XMLERR BR BEGIN2 Initialize all except top memory *** * FIX -- Fix screen and branch to BASIC errors **** FIX MOVE 1 FROM ROM(#ON) TO VDP(1) Turn on the screen $IF .BIT(BSC) @FLAG .EQ. 1 GOTO ERRBSC Error in BASIC RTN ** ************************************************************ * General warning routines * ************************************************************ WRNCHR CALL WARN :Control character removed: DATA #CHRWRN BR RETURN * ************************************************************ * General error routines * ************************************************************ ERRMEM CALL ERROR :memory full error: DATA #MEM BR RETURN * ERRPRG CALL ERROR : Program not found: DATA #PRGNF BR START Go back to menu screen * Nothing is destroyed yet. * ERRRAM $IF .BIT(BSC) @FLAG .EQ. 1 GOTO ERRRMB Go back to BASIC CALL ERROR :no memory expansion: DATA #RAMERR EXIT * BADTAG CALL ERROR :ILLEGAL TAG: DATA #ILLTAG BR LOAD * ERRCSM CALL ERROR :checksum error: DATA #CSMERR BR LOAD * ERRDDF CALL ERROR :duplicate definition: DATA #DUPDEF BR LOAD * ERRURR CALL ERROR :unresolved references: DATA #UNRREF BR LOAD * ERRNAM CALL ERROR : Name too long: DATA #NAM ERRNM2 $IF @FAC6 .DEQ. 0 GOTO ERRNM3 ST SPACE,RAM(@FAC4) Delete name on screen MOVE @FAC6 FROM RAM(@FAC4) TO RAM(1(FAC4)) ERRNM3 CALL CLNMSG Clean up message area BR EXEC *********************************************************** * ERRIO -- section for IO errors * *********************************************************** ERRIO ST RAM(FLG(SREF)),@FAC4 Get error code out. AND >E0,@FAC4 Take error code bits SRL @FAC4,5 Move 5 bits to right justify OR >30,@FAC4 Add ASCII offset. * AND >1F,RAM(FLG(SREF)) Get error code out * * Next line checks if error is reading after end-of -file. * $IF @FAC4 .EQ. >35 THEN In case of just an end-of-file. CALL CLSALL Close all the files BR EDIT Branch back to editor $END IF * CALL ERROR Regular I/O error. DATA #IO ERRIO2 CALL CLSALL Close all files without checking errors *** $IF .BIT(ASRC) @FLAG .EQ. 1 GOTO START $IF .BIT(LD) @FLAG2 .EQ. 1 GOTO LOAD $IF .BIT(OTHR) @FLAG2 .EQ. 1 GOTO BEGIN BR EDIT Go back to editor **** CLSALL DST PAB1,@SREF Close first file CALL CLSNO DST PAB2,@SREF Close second file CALL CLSNO DST PAB3,@SREF Close third file CALL CLSNO DST PAB4,@SREF Close fourth file used in COPY statement CALL CLSNO RTN **** CLSNO DST @SREF,@FAC12 Pointer to name length DADD PABLEN-1,@FAC12 ST 1,RAM(@SREF) Close file CALL DSRLNK Call DSR -- no worry about error DATA 8 CLR RAM(NLEN(SREF)) Clear name len to avoid prob with TP. RTN **** *********************************************************** * WARNING HANDLING SECTION * *********************************************************** WARN CALL CLNMSG Clean up message area MOVE 11 FROM ROM(#WRNM) TO RAM(>2A2) BR WRNENT *********************************************************** * ERROR HANDLING SECTION * *********************************************************** ERROR CALL CLNMSG Cleanup message area MOVE 9 FROM ROM(#ERRM) TO RAM(>2A2) WRNENT FETCH @FAC FETCH MESSAGE ADDRESS. FETCH @FAC+1 CLR @FAC+2 MOVE 1 FROM ROM(@FAC) TO @FAC+3 MOVE @FAC+2 FROM ROM(1(FAC)) TO RAM(>2C2) $IF @FAC .DEQ. #IO THEN If an I/O error ST @FAC4,RAM(>2D2) Display error code $END IF $IF @FAC .DEQ. #XMLERR THEN DSRL @ERRCOD,4 Change error code to ASCII SRL @ERRCOD+1,4 $IF @ERRCOD .H. 9 THEN Take care of A - F $IF @ERRCOD .H. 15 GOTO CONT Number too big so skip ADD 7,@ERRCOD $END IF $IF @ERRCOD+1 .H. 9 THEN Take care of A - F $IF @ERRCOD+1 .H. 15 GOTO CONT Skip this number ADD 7,@ERRCOD+1 $END IF DADD >3030,@ERRCOD DST @ERRCOD,RAM(>2D0) Display it on screen. $END IF CONT MOVE 23 FROM ROM(#PRESS) TO RAM(>2E2) SCAN40 SCAN BR SCAN40 Wait till hit enter. $IF @KEY .NE. ETR GOTO SCAN40 RTN **** CLNMSG ST SPACE,RAM(>2A0) CLEAN UP MSG AREA. MOVE >5F FROM RAM(>2A0) TO RAM(>2A1) RTN * ******** * DATA AREA ******* UNLM ERRM DATA :* ERROR *: PRESS DATA :PRESS ENTER TO CONTINUE: WRNM DATA :* WARNING *: MEM DATA 11,:MEMORY FULL: IO DATA 14,:I/O ERROR CODE: RAMERR DATA 19,:NO MEMORY EXPANSION: NAM DATA 13,:NAME TOO LONG: XMLERR DATA 10,:ERROR CODE: CHRWRN DATA 25,:CONTROL CHARACTER REMOVED: ILLTAG DATA 11,:ILLEGAL TAG: CSMERR DATA 14,:CHECKSUM ERROR: DUPDEF DATA 20,:DUPLICATE DEFINITION: UNRREF DATA 20,:UNRESOLVED REFERENCE: PRGNF DATA 17,:PROGRAM NOT FOUND: ****** CDATA DATA >70,>70,>70,>70,>70,>70,>70,>70 DATA 00,>7E,>42,>42,>42,>42,>7E,00 VDPRG2 DATA >E0,>0,>0E,>1,06,0,>F5 LISTM PAGE +++++ ?COPY ARCHIVE.EDTASM.V090881.SRC.USERS ?COPY ARCHIVE.EDTASM.V080581.SRC.ASSEM ?COPY ARCHIVE.EDTASM.V080581.SRC.LOADER ?COPY ARCHIVE.EDTASM.V080581.SRC.ERROR ?COPY ARCHIVE.EDTASM.V090881.SRC.BASIC ?COPY ARCHIVE.EDTASM.V090881.SRC.BUG