;********* ; * ; BASIC3 * ; * ;********* .TITLE BASIC3 ; ; OBJECT MODULE FOR PART 1 OF MAIN BASIC INTERPRETER 6 JUNE 72 ; ; DOS VERSION FROM WHICH THE RSX VERSION EVOLVED WAS ORIGIANLLY A DECUS ; LIBRARY PROGRAM MODIFIED BY FRANK KORZENIEWSKI OF RPSLMC. ; ; MODIFIED FOR USE UNDER RSX-11D ; BY: LARRY SIMPSON ; MICHAEL REESE MEDICAL CENTER ; JULY-OCTOBER 1975 ; ; ; MODIFIED FOR IMPLIED LET AND ^Z ON INPUT 6-APR-76 ; ; FEATURES CURRENTLY SUPPORTED: ; 1. PROGRAM (FILES-11) SAVE VIA SAVE COMMAND ; 2. PROGRAM (FILES-11) RECALL VIA OLD COMMAND ; 3. PROGRAM (FILES-11) EXECUTE VIA RUN COMMAND (ALLOWS CHAINING) ; 4. IMMEDIATE MODE MCR PRINT VIA ? ; 5. MULTI-USER WITH PURE AREA ; 6. ^B BREAK FEATURE ; 7. FILES-11 SEQUENTIAL DATA FILES VIA OPEN STATEMENT ; 8. IMPLIED LET (BUT NOT IN IF STATEMENT) ; 9. FILES-11 RANDOM ACCESS FILES VIA OPEN AND INPUT OR PRINT ; 10. GENERALIZED ONE LINE USER DEFINED FUNCTIONS ; A) ANY # OF ARGS ; B) RECURSIVE -> ONE FCN DEFINED IN TERMS OF ANOTHER ; C) STRING AND NUMERIC ARGS ; D) LETTERS FN & VARIABLE NAME (NUMERIC OR STRING) ; E) NUMERIC OR STRING VALUE RETURNED ; 11. PRESERVATION OF USER DATA UNLESS EXPLICIT CLEAR ; 12. IMPLIED LET IN IF STATEMENT ; 13. PROGRAM CHAIN STATEMENT (30-SEP-76) ; 14. PROGRAM OVERLAY STATEMENT (1-OCT-76) ; 15. ON ERROR GOTO (15-DEC-76) ; 16. BINARY I/O ; 17. GOSUB - RETURN IN MIDDLE OF MULTI-STATEMENT LINE ; 18. FOR - NEXT LOOPS NESTED ON ONE LINE ; 19. DEFAULT PROGRAM FILE NAME, EXTENSION AND DEVICE CHANGED ; BY OLD, CHAIN, RUN, OVERLAY (31-MAR-77) ; 20. WAIT STATEMENT ADDED (TIME OUT ON INPUT) ; 21. CTRL-C AST FOR PROGRAM STOP 11-MAY-77 ; 22. PRIORITY STATEMENT ; 23. ONE BYTE TOKEN REPLACEMENT FOR FCNS + OTHER KEY WORDS - 24-JUN-77 ; 24. SAVE + RECALL OF COMPILED PROGRAM - 29-JUN-77 ; 25. IF END STATEMENT - 22-JUL-77 ; 26. LOADABLE ASSEMBLY ROUTINES OCT-77 ; 27. LINE HEADERS WITH BINARY SEARCH MAR-78 ; 28. TRACE FEATURE MAR-78 ; 29. VIRTUAL ARRAYS MAY-78 ; 30. CONTINUED LINES JULY-78 ; 31. IF-THEN-ELSE SEP-78 ; 32. WRITE PASS ALL AND OTHER TERMINAL CONTROL NOV-78 ; ;DSS1 ; ;DSS1 ; MODIFIED FOR FPP EMULATION (CONDITIONAL ON FPPEMU) ;DSS1 ; FPPEMU DEFINED (OR NOT) IN ASSEMBLY PREFIX FILE ;DSS1 ; BY DANIEL STEINBERG 18-JAN-79 ;DSS1 ; ;DSS1 ; MODIFIED TO FORBID WILD CARDS IN FILE SPECS (THEY USED TO ONLY MATCH ;DSS1 ; THE FIRST OCCURRENCE OF A FILE (WHICH DEPENDS ONLY ON THE ORDER IN THE ;DSS1 ; DIRECTORY FILE....NOT A GOOD THING TO COUNT ON) 18-JAN-79 ;DSS1 ; ;DSS1 ; MODIFIED TO STOP EXECUTION AT NEXT LINE NUMBER WHEN BRFLAG IS SET (CONTROL-C) ;DSS1 ; (USED TO BE THAT BREAKS WOULDN'T OCCUR IF NEXT STATEMENT WAS BRANCHED TO) ;DSS1 ; ;DSS1 ; ;DSS1 ; ;DSS1 ; CONDITIONAL ON M11EXT ---- ;DSS1 ; MODIFIED TO EXTEND ITSELF ( 1K BYTES AT A TIME ) WHEN STORAGE RUNS OUT ;DSS1 ; (SEE TSTU00) ;DSS1 ; DANIEL STEINBERG 13-FEB-79 ;DSS1 ; SAME ALTERED TO WORK WITH IAS VERSION 3.2 F.BORGER, JULY 1981 ;FRB3.2 .SBTTL MACRO DEFINITIONS ;CODE TO CONVERT TRAP SUBROUTINE CALLS TO NORMAL JSR'S ;FOR OPERATION UNDER RSX. ; ;DEFINE A GENERAL MACRO TO GENERATE A SECOND MACRO WHICH ;CONVERTS A TRAP NAME OF XXXXXX TO A ; JSR PC,XXXXXX ; .MACRO TRPSUB A,B .MACRO A JSR PC,B .ENDM .ENDM ; ; NOW ALL THE ONE-TIME TRAPS THAT BASIC USES ; TRPSUB ATOI,ATOI00 ;ASCII TO INTEGER TRPSUB CLOSEF,CLOS00 ;CLOSE ANY OPEN FILES TRPSUB CLRUSR,CLRU00 ;CLOSE TEMP USER SPACE (IF ANY) TRPSUB CRLF,CRLF00 ;DO [CR,LF] TRPSUB EVAL,EVAL00 ;EVALUATE ARITHMETIC EXPRESSION TRPSUB EVALS,EVLS00 ;EVALUATE STRING EXPRESSION TRPSUB FINDLN,FIND00 ;FIND LINE NUMBER (IN R0) TRPSUB GETVAR,GETV00 ;GET TRUNCATED VARIABLE TRPSUB ITOA,ITOA00 ;CONVERT INTEGER TO ASCII TRPSUB JUNKIT,JUNK00 ;SKIP OVER TRASH TO END OF LINE TRPSUB PACK,PCK00 ;PACK LINE INTO WORKING STORAGE TRPSUB PRINTC,PRNT00 ;PRINT CHARACTER TRPSUB PRINTL,PRN00 ;PRINT LINE, R0=FBA,R1=LBA TRPSUB SCRNCH,SCR00 ;DELETE N BYTES FROM USER SPACE TRPSUB SKIP,SKIP00 ;SKIP OVER SPACES IN INPUT TEXT TRPSUB SQUISH,SQU00 ;DELETE TEXT TO TERMINATOR AND PACK TRPSUB SRCHLF,SRCH00 ;SEARCH FOR LINE FEED USING R1 AS POINTER TRPSUB STRLEN,STRL00 ;COMPUTE STRING LENGTH TRPSUB TSTCH,TST00 ;TEST CHAR (IN R2) ALPHA VS NUMERIC TRPSUB TSTOK,TSTU00 ;CHECK, IS THERE ENOUGH USER SPACE .SBTTL GLOBALS, REGISTERS AND MACRO CALLS ; ; GLOBALS--ERROR CALLS ; .GLOBL LINERR ILCERR OVFERR SBSERR SUBERR .GLOBL UNRERR UNMERR LNNERR CSIERR OPNERR .GLOBL CLSERR FNMERR EOFERR CLOSER OPENER .GLOBL TM1ERR TM2ERR SLPERR WATERR TMOERR .GLOBL PRIERR PRFERR LODERR ; ; GLOBALS--REFERENCES TO OTHER MODULES ; .GLOBL LET00 READ00 REM00 RUN00 RES00 .GLOBL RET00 DIM00 PR00 GOSB00 GOTO00 .GLOBL IF00 FOR00 NEXT00 INP00 STOP00 .GLOBL DEF00 RND01 RUN01 .GLOBL PARLST P.FCS ATTACH DETACH .GLOBL GOTO02 GOTO03 GOTO04 ERRBRN INP01 .GLOBL FPEXTR FPERMS CALL00 OPLB00 ONGT00 ; ; GLOBALS--INTERNAL, DEFINED HERE ; .GLOBL PRNT00 CRLF00 PRLN00 PRN00 TST00 .GLOBL SKIP00 FIND00 SQU00 PCK00 SRCH00 .GLOBL TSTU00 JUNK00 PUSH00 SRL00 PCK03 .GLOBL CLRU00 SCR00 ARYL00 DIMC00 GETV00 .GLOBL CLSEAL FILFND FIND01 INIT01 INIT03 .GLOBL CLOS00 OLD01 STRL00 FPEXFL .GLOBL FNMB00 LINELN LINEFL .GLOBL CSDSPT CSINT0 FILFN1 OP.LUN COMFNB .GLOBL WTMAG WTUNIT CTCENT OLD02 .GLOBL VECTAB UNLD01 SRCHFL SLUP .GLOBL SLUP01 SLDN SLDN01 PRLN01 LOAD00 ; .GLOBL INIT00 INIT02 INIT10 INIT13 .GLOBL INIT12 ; .GLOBL ENDSTK RNDM DATI STUDAT ENUDAT .GLOBL LINENO RUNF USR ENDUSR ENDTXT .GLOBL TINPT TOTPT INPT OTPT LASTEX .GLOBL STCOUN S.EOL2 S.EOS1 S.EOS2 .GLOBL S.DATA S.NEXT S.EOL1 S.BAS ; ; REGISTER ASSIGNMENTS ; R0 = %0 ;TEMPORARY AND PARAMETER TRANSFER R1 = %1 ;TEMPORARY AND PARAMETER TRANSFER R2 = %2 ;SCRATCH R3 = %3 ;SCRATCH R4 = %4 ;SCRATCH R5 = %5 ;USER LIST POINTER SP = %6 ;BASIC STACK POINTER PC = %7 ;PROGRAM COUNTER ; AC0 = %0 ;F.P. REGISTER 0 AC1 = %1 ;F.P. REGISTER 1 AC2 = %2 ;F.P. REGISTER 2 AC3 = %3 ;F.P. REGISTER 3 .PSECT VERBAD,RW,I,GBL,REL,CON ;ROUTINE ADDRESSES FOR VERBS IN HERE .PSECT BASIC3,RW,I,GBL,REL,CON ;START OF MAIN BODY ;RSX MACRO CALLS .MCALL GET$ PUT$ OPEN$R OPEN$W .MCALL CLOSE$ OPEN$ CSI$ DELET$ .MCALL CSI$1 CSI$2 NMBLK$ FDAT$R .MCALL DIR$ EXIT$S CMKT$S .MCALL CSI$SW CSI$SV .MCALL CSI$ND FDAT$R FDRC$R .MCALL MRKT$S WTSE$S .MCALL CLEF$S QIO$S WTLO$S RDAF$S .MCALL ALTP$S QIOW$S ; .IF DF,M11EXT ;IF EXTEND TASK ;DSS1 .IIF NDF,RSX11M .ERROR ;MUST BE RSX11M ;DSS1 .IIF NDF,SNGUSR .ERROR ;SNGUSR MUST BE DEFINED ;DSS1 .MCALL EXTK$S ;EXTEND TASK DIRECTIVE ;DSS1 .ENDC ;DSS1 .IF DF,IASEXT ;OR IAS VERSION 3.2 ;FRB3.2 .MCALL EXTK$S ;EXTEND TASK DIRECTIVE ;FRB3.2 .ENDC ;FRB3.2 .SBTTL PCK00 - GET A LINE FROM INPUT DATASET ; ; PACK - PCK00 GET A LINE FROM INPUT DATASET ; USE OLD DEVICE IF INITIALISED, OTHERWISE TERMINAL ; PCK00: MOV INPT,R2 ;GET FILE CONTROL BLOCK POINTER MOV R0,-(SP) ;SAVE R0 CMP #TINPT,R2 ;IS THIS TERMINAL INPUT BNE PCK06 ;BR IF NOT TST TCOUNT ;ANYTHING IN BUFFER? BLE 3$ ;BR IF NOT MOVB #'$,OUTQIO+Q.IOPL+4 ;PUT IN CARRIAGE CONTROL TSTB WPASFL ;WRITE PASS ALL FLAG? BEQ 5$ ;IF NOT, BRANCH CLRB OUTQIO+Q.IOPL+4 ;SET NULL CARRIAGE CONTROL MOV #IO.WVB!TF.WAL,OUTQIO+Q.IOFN ;SET WRITE PASS ALL FCN CODE 5$: MOV #TOTPT,OTPT ;POINT TO TERM OUT BLOCK JSR PC,PRNT01 ;FORCE OUT STUFF 3$: CLEF$S #1 ;MAKE SURE MARK TIME FLAG CLEAR MOV #IO.RVB,INPQIO+Q.IOFN ;SET NORMAL READ FCN CODE TSTB RPASFL ;READ PASS ALL SET? BEQ 6$ ;IF NOT, BRANCH BIS #TF.RAL,INPQIO+Q.IOFN ; SET READ PASS ALL SUBFCN CODE 6$: TSTB ECHOFL ;ECHO SET? BNE 7$ ;IF SO, BRANCH (NORMAL) BIS #TF.RNE,INPQIO+Q.IOFN ; SET READ NO ECHO SUBFCN CODE 7$: DIR$ #INPQIO ;DO THE READ BCC 4$ ;IF OK, BRANCH JMP PCK14 ;ELSE REPORT ERROR 4$: TST WTMAG ;TIME OUT SPEC'D? BEQ 2$ ;IF NOT, SKIP MARK TIME MRKT$S #1,WTMAG,WTUNIT ;SET MARK TIME 2$: WTLO$S 0,#3 ;WAIT FOR SOMETHING TO HAPPEN SUB #10,SP ;ALLOCATE SPACE FOR 4 WD BLOCK MOV SP,R0 ;PTR TO BLOCK -> R0 RDAF$S R0 ;GET THE 4 FLAG WORDS MOV (R0),R0 ;GET FIRST FLAG WD -> R0 ADD #10,SP ;CLEAN UP STACK BIT #1,R0 ;CHECK FOR FLAG 1 (MARK TIME) BEQ 1$ ;IF FLAG CLEAR, READ FINISHED - BRANCH MOV #IO.KIL,INPQIO+Q.IOFN ;SET KILL READ REQUEST DIR$ #INPQIO ;DO THE KILL JSR PC,ATTACH ;AND NOW RE-ATTACH TERMINAL TMOERR ;ERROR TRAP (TIMEOUT) 1$: CMKT$S #1 ;CANCEL MARK TIME MOV INPSTA,R1 ;IO STATUS -> R1 ADD #14,R2 ;UPDATE R2 AND MOV INPSTA+2,R0 ;PUT AWAY THE COUNT TSTB R1 ;ERROR? BMI PCK13 ;IF SO, PROCESS ERROR BR PCK15 ;ELSE PROCESS LINE SUCCESSFULLY PCK06: ADD #14,R2 ; MOV (R2),R0 ;R0 CONTAINS FDB ADDRESS GET$ ,-4(R2),-12(R2) ;GET RECORD WITH EXPLICIT RECORD BUFFER BCC PCK02 MOVB F.ERR(R0),R1 ;ERROR CODE IN R1 PCK13: MOV (SP)+,R0 ;RESTORE R0 CMPB R1,#IE.EOF ;IS IT END OF FILE? BEQ 1$ ;IF SO, BRANCH CMPB R1,#IE.PRI ;MIGHT BE READ PAST END OF RAN ACC BNE PCK01 ;FILE, IF NOT PRIVILEGE ERROR, BRANCH BIT #2000,-16(R2) ;MAKE SURE RAN ACC FILE BEQ PCK01 ;IF NOT, REGULAR ERROR 1$: CLR LINEFL ;IN CASE BINARY OR INPUT LINE CMP #LNKOLD,R2 ;IS THIS EOF ON OLD D.S. BEQ PCK09 ;BR IF SO MOV 2(R2),R0 ;MAYBE SAVE EOF LINE NUMBER BNE PCK07 ;IF THERE, GO PROCESS CMP #LNKTIN,R2 ;IS IT TERMINAL BEQ PCK12 ;IF YES CHECK FURTHER ;ELSE DO ERROR WHICH CLOSES ALL FILES PCK08: EOFERR ;EOF ERROR ;EOF IN RUN MODE WITH USER EXIT PCK07: MOV ENDSTK,SP ;RESET STACK FINDLN ;GO LOOK FOR IT BNE PCK08 ;ERROR IF NOT FOUND JMP INIT13 ;ELSE GO PROCESS PCK12: TST RUNF ;ARE WE RUNNING? BEQ PCK11 ;IF NOT, EXIT JMP STOP00 ;ELSE, JUST STOP PCK11: CLRUSR ;DO CLEAR SO FILES GET CLOSED EXIT$S ;WE GOTTA GET OUTA THIS PLACE.. ;EOF ON OLD INPUT FILE PCK09: CLOSEF ;CLOSE OLD CLR OLDFLG ;SHOW NORMAL END IF PROGRAM INPUT MOV ENDSTK,SP ;RESET STACK TST RUNF ;ARE WE IN RUN MODE BEQ PCK10 ;BR IF OLD COMMAND JMP RUN01 ;ELSE RUN IT PCK10: JMP INIT00 ;GET ANOTHER COMMAND PCK01: CMPB R1,#IE.DNR ;IS THIS A HUNG-UP TTY BEQ PCK11 ;IF SO, CLOSE DOWN SHOP MOV R1,PARLST+P.FCS ;RECORD FCS ERROR CODE PCK14: LINERR ;ELSE GIVE ERROR MESSAGE PCK02: MOV F.NRBD(R0),R0 ;RECORD SIZE -> R0 PCK15: MOV -4(R2),R1 ;ADDRESS OF DATA IN R1 MOV R0,LINELN ;RECORD LINE LEN IN CASE "INPUT LINE" ADD R1,R0 ;CHAR AFTER RECORD IN R0 TST LINEFL ;DOING LINE? BEQ PCK03 ;IF NOT, CHECK LEGALITY OF CHARS MOV R0,R1 ;ELSE POINT R1 TO END OF LINE BR PCK05 ;AND DO END OF LINE PROCESSING PCK03: CMP R0,R1 ;END OF STRING? BLE PCK05 ;IF SO BRANCH CMPB #140,@R1 ;CHECK NOT TOO BIG BLE PCK04 ;ERROR CMPB #40,(R1)+ ;CHECK NOT TOO SMALL BLE PCK03 ;DO NEXT CMPB #11,-1(R1) ;WAS IT TAB? BEQ PCK03 ;IF SO, IT'S OK PCK04: ILCERR PCK05: MOVB #S.EOL2,(R1) ;SET LINE TERMINATOR MOV -4(R2),R1 ;SET DATA ADDRESS MOV (SP)+,R0 ;RESTORE R0 RTS PC ;AND RETURN .PSECT BASIC3 USDFNB: NMBLK$ BASDAT,DAT,0,SY,0 SCDFNB: NMBLK$ SCR,BAS,0,SY,0 ;DFNB FOR SCRATCH FDB .SBTTL PRNT00 - OUTPUT CHARACTER OR LINE ; ; PRINTC - PRNT00 OUTPUTS CHARACTER IN R2 ; ON SAVE DEVICE IF INITED, OTHERWISE ON TERMINAL ; ; FOLLOWING CODE OUTPUTS A SINGLE CHARACTER INTO FILE BUFFER .PSECT BASIC3 PRNT00: MOV R0,-(SP) ;SAVE A REGISTER MOV OTPT,R0 ;GET CNTRL BLOCK ADD -> R0 CMP 2(R0),6(R0) ;COMPARE MAX TO ACTUAL BHI 1$ ;IF STILL ROOM, BRANCH JSR PC,PRNT01 ;IF NOT, PRINT LINE 1$: MOVB R2,@(R0) ;PUT CHARACTER IN BUFFER INC (R0) ;PUSH PTR ALONG INC 6(R0) ;AND ADD TO ACTUAL COUNT MOV (SP)+,R0 ;RESTORE R0 RTS PC ;AND RETURN WHERE CALLED ; ; SUBROUTINE TO PRINT OUT A LINE BUFFER ; WHICH HAS BEEN ACCUMULATED ; ON ENTRY: ; OTPT IS PTR TO DEVICE FOR PRINT ; ON EXIT: ; LINE PRINTED ; BUFFER PTRS INITIALIZED ; REGISTERS USED: NONE ; CRLF00: PRNT01: MOV R0,-(SP) ;SAVE A COUPLE MOV R1,-(SP) ;OF REGISTERS MOV OTPT,R0 ;POINT TO CONTROL BLOCK MOV R0,R1 ;COPY ADD -> R1 MOV 10(R1),(R1) ;RESET BUFFER ADDRESS MOV 14(R1),R0 ;FDB ADDRESS (OR QIO BLOCK ADDRESS) -> R0 CMP R1,#TOTPT ;IS THIS TERMINAL OUTPUT? BEQ 2$ ;IF SO, SPECIAL CODE PUT$ ,10(R1),6(R1) ;DO PUT TO FILE BCS 4$ ;IF ERROR, GO TO ERROR ROUTINE 1$: CLR 6(R1) ;CLEAR THE COUNT MOV (SP)+,R1 ;RESTORE REGISTERS MOV (SP)+,R0 ; RTS PC ;AND RETURN 2$: MOV 10(R1),Q.IOPL(R0) ;SET ADDRESS OF BUFFER MOV 6(R1),Q.IOPL+2(R0) ;SET BUFFER LENGTH BNE 6$ ;IF NON-ZERO, BRANCH CLRB @10(R1) ;ELSE PUT NULL IN BUFFER INC Q.IOPL+2(R0) ;AND ADD ONE TO BUFFER LENGTH 6$: DIR$ R0 ;DO THE QIO MOVB #40,Q.IOPL+4(R0) ;RESET CARRIAGE CONTROL MOV #IO.WVB,OUTQIO+Q.IOFN ;RESET FCN CODE BCS 3$ ;IF ERROR, BRANCH BR 1$ ;AND GO FINISH 3$: MOV OUTSTA,PARLST+P.FCS ;SET UP FILE ERROR CODE BR 5$ ;AND GO DECLARE ERROR 4$: MOVB F.ERR(R0),R0 ;ERROR CODE WITH EXTENDED SIGN -> R0 MOV R0,PARLST+P.FCS ;STORE IT AWAY 5$: PRNERR ;DECLARE ERROR IN PRINT .SBTTL BREAK - WRITE PASS ALL COMMAND ;+3 ; .S ; .X R0 MOV 2(R3),R1 ;DIMENSIONS -> R1 BEQ 1$ ;IF BOTH ZERO, SHORT CUT (BRANCH) JSR PC,STRL00 ;ELSE GO COMPUTE STRING LENGTH ADD #6,R0 ;ACCOUNT FOR HEADER 2$: ADD R0,R3 ;MOVE US AROUND THE STRING BR SRL08 ;AND GO LOOK AGAIN 1$: ADD #10,R0 ;ADD 6 FOR HEADER, 1 FOR LEN BYTE AND ;1 FOR ROUNDUP BIC #1,R0 ;MAKE SURE EVEN BR 2$ SRL10: TM2ERR ;SHOULDN'T HAVE THIS TYPE SRL11: MOV (R3),R0 ;HEADER BACK IN R0 ADD #3,R0 ;ROUND UP LENGTH BIC #160001,R0 ;MAKE EVEN AND CLEAR TYPE ADD R0,R3 ;GET TO NEXT ITEM BR SRL08 SRL12: MOV R3,PARLST+P.FCS ;STORE ADDRESS IN FCS ERROR LOCATION MOV R0,PARLST+P.FLNM ;STORE LAST INCREMENT MOV R4,PARLST+P.FNAM ;AND SEARCH TYPE TM1ERR ;DECLARE DEBUGGING ERROR SRL13: ADD #16,R3 ;GO AROUND VIRTUAL ARRAY ELEMENT DESCRIPTOR BR SRL08 .SBTTL ARYL00 - COMPUTE NUMERIC ARRAY LENGTH ; ; ON ENTRY: ; R0 HAS DATA TYPE (0=REAL*4, 2=INTEGER*2, 4=BYTE) ; R3 POINTS TO CURRENT DATA ITEM ; ; ON EXIT: ; R0 HAS LEN OF ITEM ROUNDED UP, BUT EXCLUDING HEADER ; R3 AS ABOVE ; ; OTHER REGISTERS USED: R1 ; .ENABL LSB ARYL00: MOV 5$(R0),-(SP) ;PUT MULTIPLICATION FACTOR ON STACK MOV 2(R3),-(SP) ;AND PACKED DIMENSIONS BNE STRL01 ;IF NON-ZERO, BRANCH CLR R0 ;ELSE SHORT CUT BR 2$ 5$: .WORD 4 ;REAL*4 .WORD 2 ;INTEGER*2 .WORD 1 ;BYTE ; .SBTTL STRL00 - COMPUTE LENGTH OF STRING DATA ITEM ; ; ON ENTRY: ; R0 HAS INDIVIDUAL STRING LENGTH ; R1 HAS PACKED DIMENSIONS ; ; ON EXIT: ; R0 HAS TOTAL LENGTH OF STRING ROUNDED UP, BUT EXCLUDING HEADER ; STRL00: INC R0 ;ACCOUNT FOR LENGTH BYTE IN STRING MOV R0,-(SP) ;SAVE IT AS MULT FACTOR ON STACK MOV R1,-(SP) ;PACKED DIMENSIONS ON STACK STRL01: CLR R0 ;CLEAR OUT REGISTER BISB (SP),R0 ;FIRST DIM -> R0 (UNSIGNED) BEQ 1$ ;IF ZERO, CAN SKIP COME CODE CLR R1 ;CLEAR OTHER REGISTER BISB 1(SP),R1 ;GET 2ND DIM -> R1 (ALSO UNSIGNED) BEQ 2$ ;IF ZERO, ALSO CAN SKIP CODE INC R0 ;ADD ONE TO EACH DIM INC R1 ;TO ACCOUNT FOR ZEROTH ELEMENT MUL R1,R0 ;PRODUCT -> R0, R1 TST R0 ;CHECK HIGH ORDER WORD BNE 4$ ;IF NON-ZERO, ERROR MOV R1,R0 ;IF OK, PUT RESULT -> R0 BR 3$ ;BRANCH AROUND SHORT CUT CODE 1$: BISB 1(SP),R0 ;2ND DIM -> R0 2$: INC R0 ;ACCOUNT FOR ZEROTH ELEMENT 3$: TST (SP)+ ;POP DIMENSIONS MUL (SP)+,R0 ;MULTIPLY BY LENGTH OF 1 ELEMENT TST R0 ;AGAIN CHECK HIGH WORD OF RESULT BNE 4$ ;IF NON-ZERO, ERROR MOV R1,R0 ;RESULT BACK TO R0 INC R0 ;NOW DO ROUND-UP BIC #1,R0 ;IN CASE ODD SIZE RTS PC 4$: OVFERR ;OVERFLOW ERROR IF ARRAY TOO BIG .DSABL LSB .SBTTL SCR00 - DELETE BYTES FROM R3 TO R4 FROM USER STORAGE ; ; SCRNCH - SCR00, DELETE THE NUMBER OF BYTES FROM THE USER STORAGE ; SPECIFIED BY R4. R3 POINTS TO STARTING POINT FOR THE ; DELETION. REGISTERS USED - R2,R3,R4 ; SCR00: MOV R3,R2 ;GET A COPY OF THE POINTER ADD R4,R2 ;R2 HAS START OF REMAINING DATA MOV ENUDAT,R4 ;END OF REMAINING DATA IN R4 SUB R2,R4 ;LEN OF REMAINING DATA IN R4 ASR R4 ;# WDS OF REMAINING DATA BEQ 2$ ;IF ZERO, SKIP THE MOVE 1$: MOV (R2)+,(R3)+ ;MOVE OLD DATA DOWN SOB R4,1$ 2$: MOV R3,ENUDAT ;ESTABLISH NEW END OF DATA RTS PC .SBTTL SQU00 - DELETE ONE LINE OF TEXT ; ; SQUISH - SQU00, DELETE LINE WHOSE HEADER IS POINTED TO BY R5 ; ON ENTRY: ; R5 HAS POINTER TO LINE HEADER ; ON EXIT: ; R5 = OLD R5 + 4 (POINTS TO PRECEDING LINE HEADER) ; R1 POINTS TO INSERTION POINT FOR NEW LINE (WHERE OLD LINE WAS) ; OLD LINE HEADER AND LINE TEXT ARE DELETED ; ENDTXT AND BOLNHD UPDATED ; SQU00: MOV 2(R5),R1 ;GET TEXT OFFSET ADD USR,R1 ;ADD BASE FOR ABS ADD MOV R1,R2 ;GET TWO COPIES SRCHLF ;START OF NEXT LINE -> R1 MOV R1,-(SP) SUB R2,(SP) MOV ENDTXT,R3 ;CALC # OF CHARS SUB R1,R3 ;TO MOVE -> R3 BEQ 2$ ;IF ALREADY THERE, SKIP CODE 1$: MOVB (R1)+,(R2)+ ;SLIDE REST OF CODE DOWN SOB R3,1$ 2$: MOV BOLNHD,R2 ;BOTTOM OF LINE HEADER AREA -> R2 MOV R5,R3 ;CURRENT POSITION IN HEADERS -> R3 MOV R0,-(SP) ;SAVE R0 MOV #4,R0 ;4 BYTES TO MOVE UP JSR PC,SLUP ;SLIDE IT ALL UP ADD R0,R5 ;ADJUST POSITION OF R5 ADD R0,BOLNHD ;AND BOTTOM OF HEADER AREA MOV (SP)+,R0 ;RESTORE OLD R0 MOV (SP)+,R2 ;# OF BYTES WE MOVED TEXT DOWN BY -> R2 MOV #4,R3 MOV R5,-(SP) ;SAVE HEADER INSERTION POINT 3$: SUB R3,R5 ;NOW GO THROUGH ALL HEADERS PAST CMP R5,BOLNHD ;ONE WE DELETED AND ADJUST THEIR BLO 4$ ;OFFSETS TO ACCOUNT FOR MISSING TEXT SUB R2,2(R5) BR 3$ 4$: SUB R2,ENDTXT ;ALSO ADJUST END OF TEXT POINTER MOV (SP)+,R5 ;RESTORE HEADER INSERTION POINT CMP R5,BOLNHD ;IS IT AT END OF PROGRAM? BNE 5$ ;IF NOT, BRANCH MOV ENDTXT,R1 ;IF SO, ENDTXT IS INSERTION POINT BR 6$ 5$: MOV -2(R5),R1 ;GET INSERTION OFFSET (START OF NEXT LINE) ADD USR,R1 ;AND MAKE IT ABSOLUTE 6$: RTS PC .SBTTL SRCH00 - SEARCH FOR EOL ; ; SRCHLF - SRCH00, SEARCH FOR EOL, POINTER IN R1, WHEN DONE R1 ; POINTS ONE BYTE AFTER THE EOL. REGISTERS USED - R1. ; SRCH00: CMPB (R1)+,#S.EOL2 ;IS THIS CHAR A LINE TERMINATOR? BNE SRCH00 ;NO RTS PC .SBTTL FIND00 - SEARCH TEXT FOR LINE NUMBER (SPECIFIED IN R0) ; ; FINDLN - FIND00 ; SUBROUTINE TO FIND A GIVEN LINE IN THE PROGRAM TEXT ; BY SEARCHING THROUGH LINE NUMBER HEADERS ; ON ENTRY: ; R0 HAS REQUIRED LINE NUMBER ; ON EXIT: ; R1 HAS ABSOLUTE START OF LINE IF MATCH ; R1 HAS INSERTION POINT IN TEXT IF NO MATCH ; R5 POINTS TO HEADER IF MATCH ; R5 POINTS TO HEADER INSERTION POINT IF NO MATCH ; 'Z' SET IF MATCH ; 'Z' CLEAR IF NO MATCH ; R0 UNCHANGED ; OTHER REGISTERS USED: R2 ; FIND00: MOV STUDAT,R1 ;R1 PTS ABOVE LOWEST LINE # HEADER MOV BOLNHD,R2 ;R2 PTS TO HIGHEST LINE # HEADER FIND01: CMP R1,R2 ;ANY TEXT? BEQ 8$ ;IF NOT, BRANCH 1$: CMP R0,-4(R1) ;SEE IF IN RANGE BLO 4$ ;IF TOO LOW, R1 IS INSERTION POINT, BRANCH BEQ 7$ ;IF MATCH, BRANCH CMP R0,(R2) ;CHECK OTHER END OF RANGE BHI 8$ ;IF TOO HIGH, R2 IS INSERTION PT, BRANCH BEQ 11$ ;IF MATCH AT THIS END, BRANCH MOV R1,R5 ;OTHERWISE LET'S SPLIT SUB R2,R5 ;DIFFERENCE: DIVIDE BY 8, ASH #-3,R5 ;CLEAR REMAINDER CLC ;(C-BIT) AND ASH #2,R5 ;MPY BY 4 ADD R2,R5 ;ADD BACK OFFSET CMP R0,(R5) ;AND SEE WHERE WE ARE BEQ 3$ ;IF A HIT, BRANCH BHI 2$ ;IF IN UPPER HALF, BRANCH MOV R5,R2 ;IN LOWER HALF, SO RESET BR 1$ ;RANGE AND TRY AGAIN 2$: MOV R5,R1 ;IN UPPER HALF, SO RESET BR 1$ ;RANGE AND TRY AGAIN 3$: MOV 2(R5),R1 ;SET POINT IN TEXT ADD USR,R1 ;WITH OFFSET IN SEZ ;SUCCESS INDICATOR RTS PC ;AND RETURN 4$: MOV R1,R5 ;SET HEADER INSERTION POINT BR 5$ 7$: MOV R1,R5 ;SET FOR MATCH ON SUB #4,R5 ;FOLLOWING LINE BR 3$ ;AND FINISH MATCH CODE 8$: MOV R2,R5 ;SET HEADER INSERTION AT HIGH END OF LINE NOS. CMP R5,BOLNHD ;AT BOTTOM OF HEADERS (PAST END OF PROG)? BEQ 10$ ;IF SO, BRANCH 5$: MOV -2(R5),R1 ;START OF NEXT LINE IS TEXT INSERTION POINT ADD USR,R1 ;ADD IN START OF TEXT SECTION 9$: CLZ ;SET NO MATCH RTS PC ;AND RETURN 10$: MOV ENDTXT,R1 ;END OF TEXT IS INSERTION POINT BR 9$ ;GO FINISH 11$: MOV R2,R5 ;MATCH AT HIGH LINE # END OF RANGE BR 3$ ;GO FINISH .SBTTL GETV00 - GET VARIABLE AND PACK INTO R4 ; ; GETVAR - GETV00, GET A VARIABLE AND PACK IT IN TRUNCATED ASCII INTO ; R4. ON RETURN R4 HAS VARIABLE, R2 HAS NEXT CHARACTER. ; REGISTERS USED - R1,R2,R4. ; GETV00: SKIP ;GET A CHARACTER TSTCH ;ALPHABETIC? BEQ 99$ ;NO BVS 99$ ;NO BIC #177700,R2 ;TRUNCATE IT MOV R2,R4 ;AND CLC ASH #6,R4 ;SHIFT OVER THE FIRST PART OF THE NAME MOVB (R1)+,R2 ;NEXT CHAR -> R2 TSTCH ;NUMERIC OR ALPHA? BVS 1$ ;NO BIC #177700,R2 ;CLEAR OUT EXTRANEOUS BITS BIS R2,R4 ;YES, ZOT IT INTO THE HEADER MOVB (R1)+,R2 ;ANOTHER CHAR -> R2 1$: CCC RTS PC ;RETURN OK 99$: SEV ;SET OVERFLOW FOR BAD VARIABLE RTS PC .SBTTL DIMC00 - CHECK RANGE OF DIMENSION (IN R0) ; ; DIMCHK - DIMC00, MAKE SURE DIMENSION IN R0 IS IN BOUNDS 0 TO 255 ; REGISTERS USED - R0. ; DIMC00: CMP R0,#377 ;IN 0 -> 255. RANGE? BHI 1$ ;IF NOT, BRANCH SEZ ;SET EQUAL CODE IF IN BOUNDS RTS PC 1$: CCC ;SET ILLEGAL DIMENSION RTS PC .SBTTL SAVE00 - LIST PROGRAM ON "SAVE" DATASET ;+2 ; .SKIP ; .X ^^SAVE\\ ; .X ^PROGRAM SAVE ; .HEADERLEVEL 1 ^^SAVE _ [N1][-N2][,N3...]\\ ; .BREAK ; ^PRIMARILY AN IMMEDIATE MODE COMMAND. ; ^IT MAKES A COPY OF THE PRESENT PROGRAM ON THE FILE NAMED IN ; THE STRING FILESPEC (STRING VARIABLE OR STRING IN QUOTES). ; ^OPTIONAL LINE NUMBERS OR LINE NUMBER RANGES CAN BE INCLUDED. ; .FG 1 ; ^THE OPTIONAL SWITCH WILL PRODUCE A PSUEDO-COMPILED VERSION ; WHICH CAN BE READ BACK WITH THE SAME SWITCH WITHOUT ; RE-INTERPRETING THE CODE THUS SAVING A CONSIDERABLE AMOUNT ; OF TIME FOR LONG PROGRAMS. ; ^THE DEFAULT EXTENSION WILL BE \\ ; .BREAK ; ^THE ^^OLD\\ COMMAND READS IN A PREVIOUSLY SAVED OR EDITED PROGRAM ; FROM THE FILE NAMED IN THE STRING FILESPEC (AS IN ^^SAVE\\). ; ^THE OPTIONAL SWITCH, WHEN SPECIFIED, CAUSES TRUNCATION OF ; ^^REM\\ AND ! STATEMENTS. ; ^THE DEFAULT FILE SPECIFIER IS: ^^SY:PROGRAM.BAS\\ ; ^THE R2 MOV #4,R3 ;SET TO XFER NAME AND EXTENSION 11$: MOV (R0)+,(R2)+ ;MOVE IN NAME SOB R3,11$ ;AND EXTENSION ADD #14,R0 ;POINT TO ADD #14,R2 ;DEVICE NAME MOV (R0)+,(R2)+ ;TRANSFER IT IN MOV (R0)+,(R2)+ ;AND UNIT # ; JMP INIT04 ;BACK TO INTERPRETER CLRTXT: MOV USR,R5 ;DELETE ALL INC R5 ;LEAVE ORIGINAL LF MOV R5,ENDTXT ;SAVE CLR LINENO ;CLEAR LINE NUMBER MOV STUDAT,BOLNHD ;DELETE LINE HEADERS RTS PC ;RETURN SETEXT: MOV #6273,COMFNB+N.FTYP ;SET "BAS" EXTENSION BIT #2,REMTRM ;DO WE HAVE /CO SWITCH? BEQ 1$ ;IF NOT, ALL OK AND BRANCH MOV #6253,COMFNB+N.FTYP ;SET "BAC" EXTENSION MOV #1,LINEFL ;ENABLE READING OF STRANGE CHARS 1$: RTS PC ;AND RETURN .SBTTL CHAIN0 - START EXECUTING NEW FILE WITH OLD DATA ;+2 ; .SKIP ; .X ^^CHAIN\\ ; .X ^PROGRAM CHAIN ; .HEADERLEVEL 1 ^^CHAIN _\\ ; .BREAK ; ^THE ^^CHAIN\\ COMMAND READS IN ANOTHER ^^BASIC\\ PROGRAM WHILE ; PRESERVING VARIABLES AND OPEN FILES' ^^FCB\\'S. ; ^^GOSUB/RETURN\\ POINTERS, ^^FOR\\ LOOP CONTROL TABLES, USER ^^DEF\\INED ; FUNCTIONS AND SCRATCH ITEMS ARE ALL DELETED FROM THE USER DATA AREA. ; ^THUS USER FUNCTIONS MUST BE REDEFINED IN ANY NEW PROGRAM MODULE. ; .FG 1 ; ^THE DEFAULT FILE SPECIFIER AND SWITCHES ARE THE SAME AS FOR THE ; ^^OVERLAY\\ COMMAND WITH THE ADDITION OF THE /
  • R1 MOV (R3)+,R0 ;SIZE AND TYPE -> R0 BIC #177400,R0 ;CLEAR OUT SIGN EXTEND STRLEN ;CALC LEN -> R0 ADD R0,R3 ;ADD IT ON BR CHAIN1 ;AND LOOK AT NEXT ITEM CHN14: TM2ERR ;SHOULDN'T HAVE THIS DATA TYPE CHN16: MOV (R3),R4 ;SCRATCH HEADER -> R4 ADD #3,R4 ;ADD HEADER AND ROUND UP BIC #160001,R4 ;ALSO CLEARING HEADER TYPE BR CHN03 ;AND DELETE ITEM CHN13: ADD #16,R3 ;SKIP AROUND VIRTUAL DATA ITEM BR CHAIN1 .SBTTL OVERLAY - ADD PROGRAM LINES FROM FILE AND OPTIONALLY EXECUTE ;+2 ; .SKIP ; .X ^^OVERLAY\\ ; .X ^PROGRAM OVERLAY ; .HEADERLEVEL 1 ^^OVERLAY _\\ ; .BREAK ; ^THE ^^OVERLAY\\ COMMAND READS IN ADDITIONAL PROGRAM TEXT FROM THE SPECIFIED ; FILE AND ADDS THEM TO THE EXISTING PROGRAM JUST AS THOUGH THEY WERE TYPED ; FROM THE KEYBOARD: I.E. NEW STATEMENTS WITH THE SAME LINE NUMBER AS AN ; EXISTING STATEMENT REPLACE THE EXISTING STATEMENT. ; ^THE SAME PRECAUTIONS REGARDING FUNCTION DEFINITIONS AND ^^DATA\\ STATEMENTS ; DURING DEBUGGING SHOULD ALSO BE OBSERVED WHEN USING THE ^^OVERLAY\\ ; STATEMENT IN PROGRAM MODE. ; .FG 1 ; ^THE OPTIONAL SWITCH (/^L^I) IS SIGNIFICANT IN PROGRAM MODE ONLY AND CAN BE ; USED TO SPECIFY THE LINE AT WHICH EXECUTION SHOULD RESUME. ; ^THE /\\ ; .BREAK ; ^THE ^^SCRATCH\\ COMMAND MUST HAVE A FILE SPECIFIER WITH AN ; EXPLICIT VERSION NUMBER IN ORDER TO DELETE A FILE. ; ^THE DEFAULT FILE SPECIFIER IS: ^^SY:PROGRAM.BAS\\ ; .BREAK ; ^EXAMPLE: ; .NOFILL ; ^^ ; {SCRATCH "DATA.DAT;3"} ; {50 SCRATCH "DK1:DAT3.TMP"} ; \\ ; .FILL ;- SCRA00: SKIP ;GET NEXT CHAR DEC R1 ;RESET TEXT POINTER CMP R2,#S.EOS1 ;A NEW STATEMENT? BLO 1$ CSIERR ;MUST HAVE TEXT STRING 1$: JSR PC,FNAME ;CHECK FOR STRING EXPRESSION MOV R0,-(SP) ;SAVE R0 FROM EVIL JSR PC,CSINT0 ;GET FILE SPECS DELET$ #COMFDB,SCRFER ;DELETE FILE SPECIFIED IN FDB MOV (SP)+,R0 ;RESTORE R0 BACK INTO EVIL TST R0 ;WAS A STRING EXPRESSION USED BEQ 2$ ;SKIP IF NOT MOV R0,R1 ;ELSE RESET TEXT POINTER 2$: JMP INIT02 ;GO TO COMMAND INTERP .SBTTL FNAME - CHECK STRING EXPRESSION FOR FILE SPEC ; ; FNAME - CHECK FOR STRING EXPRESSION IN FILE SPEC ; ON ENTRY R1 CONTAINS TEXT POINTER ; ON EXIT FOLLOWING REGISTER ASSIGNMENTS: ; R0: ZERO IF NO STRING TO INTERPRET, OTHERWISE = OLD R1 ; R1: TEXT POINTER ; R2: ZERO TO INDICATE NO SWITCH TABLE FOR CSI ; R3: ADDRESS OF STRING IN STRING WORK AREA (FROM EVALS) ; R4: LENGTH OF STRING IN STRING WORK AREA (FROM EVALS) ; FNAME: MOV R1,-(SP) ;SAVE TEXT POINTER EVALS ;TRY FOR STRING EXPRESSION BVC 2$ ;BR IF OK STRING 3$: MOV (SP)+,R1 ;RESTORE TEXT POINTER CLR R0 ;SET NO STRING FLAG RTS PC ;AND RETURN 2$: TST R4 ;IS IT A NULL STRING BEQ 3$ ;IGNORE IF SO TST (SP)+ ;DELETE TEXT POINTER CLR R2 ;SET NO SWITCH TABLE CLR REMTRM ;RESET ALL OF THE SWITCHES MOV R1,R0 ;INDICATE STRING EXISTS RTS PC ;AND RETURN .SBTTL OPEN COMMAND PROCESSOR ;+6 ; .SKIP ; .X ^^OPEN\\ ; .X ^FILE OPEN ; .X ^RANDOM ACCESS ^I/^O ; .HEADERLEVEL 1 ,OP.LUN CSI$SW WR,<400*FO.WRT>,OP.LUN CSI$SW UP,<400*FO.UPD>,OP.LUN CSI$SW MO,<400*FO.MFY>,OP.LUN CSI$SW AP,<400*FO.APD>,OP.LUN CSI$SW SH,<400*FA.SHR>,OP.LUN CSI$ND LENVAL: CSI$SV DECIMAL,OP.LEN,2 CSI$ND EOFVAL: CSI$SV DECIMAL,OP.EOF,2 CSI$ND ; ;SET DEFAULTS FOR FILE OPEN ; OPEN00: MOV #S.FDB,R0 ;SIZE OF FDB IN R0 ASR R0 ;NOW IN WORDS 1$: CLR -(SP) ;CLEAR SPACE ON STACK SOB R0,1$ ;FOR FDB MOV SP,FDBSAV MOV SP,R0 FDAT$R R0,#R.VAR,#FD.CR,#80.,#-5 ;ESTABLISH DEFAULTS MOV #80.,OP.LEN MOV #OP.LUN,R4 CLR (R4)+ CLR (R4)+ CLR (R4)+ MOV #,(R4)+ ;SET DEFAULT TYPE & CARR CNTL FDOP$R R0,OP.LUN,#CSDSPT,#USDFNB,FO.RD ; END OF FDB INIT CODE SKIP CMPB #'#,R2 ;FILE NUMBER TO FOLLOW?? BNE OPEN01 ;ERROR IF NOT EVAL ;GET FILE NUMBER BVS OPEN01 ;PAREN IS ERROR STCFI AC0,R4 ;MAKE FILE NUMBER INTEGER MOVB R4,OP.LUN ;FILE # = LUN MOV FDBSAV,R0 ;R0 POINTS TO START OF STACK FDB CMP R4,#2 ;#1 & 2 RESERVED BLE OPEN01 CMP R4,#OP.MXL ;SEE IF GREATER THAN MAX ALLOWED BGT OPEN01 CLR R0 JSR PC,FILFN1 ;FINISH GETTING FILE BNE OPEN01 ;ERROR IF RE-OPEN ATTEMPTED SKIP CMPB #',,R2 ;SEPARATOR?? BNE OPEN01 ;ERR IF NOT EVALS ;GET FILE SPEC. BVC OPEN07 ;BR IF OK OPEN01: OPNERR OPEN07: MOV R1,-(SP) ;SAVE TEXT POINTER MOV R4,R0 ;LEN -> R0 FOR CSINT0 MOV #OPENSW,R2 ;SWITCH TABLE ADDRESS IN R2 JSR PC,CSINT0 ;DECODE STRING MOV (SP)+,R1 ;RESTORE TEXT POINTER MOV FDBSAV,R3 ;R3 POINTS TO START OF STACK FDB MOV OP.LUN,F.LUN(R3) ;PUT IN LUN AND FILE ACCESS BITS MOV OP.RTP,F.RTYP(R3) BEQ OPEN02 ;IF NO RECORD TYPE, THEN BLOCK XFER MOV OP.RAC,F.RACC(R3) BITB #FD.RAN,F.RACC(R3) ;IS RANDOM BIT SET? BEQ 2$ ;IF NOT SKIP NEXT INSTRUCTION BISB #R.FIX,F.RTYP(R3) ;IF SO FORCE FIXED RECORDS 2$: BITB #R.FIX,F.RTYP(R3) ;SEE IF FIXED RECORD SPECIFIED BEQ 1$ ;DON'T DO ANYTHING IF NOT BIC #R.VAR,F.RTYP(R3) ;IF SO CLEAR VARIABLE BIT 1$: ; CHECK BUFFER LENGTH AND CONTROL BLOCK FOR ROOM INC OP.LEN ;ROUND UP TO EVEN BIC #1,OP.LEN ;WORD BUFFER LENGTH MOV OP.LEN,R0 ;PUT IT IN R0 MOV R0,F.RSIZ(R3) ;AND IN FDB ADD #S.FDB+30,R0 ;ADD IN CONTROL BLOCK LEN AND WORD FUDGE TSTOK ;ENOUGH ROOM? BHIS 11$ ;PROCEED IF OK OVFERR ;REPORT STORAGE OVERFLOW 11$: JSR PC,CREFDB ;GO CREATE FDB REGION MOV R5,R4 ;SAVE A COPY OF FDB START ;R0 ASSUMED CLEAR FROM SOB LOOP MOV FDBSAV,R3 ;R3 POINTS TO START OF STACK FDB BITB #FA.WRT,F.FACC(R3) ;WAS WRITE SPECIFIED BEQ 13$ ;IF NOT GO SET READ BIS #1000,R0 ;SET WRITE IN CONTROL WORD BITB #FD.RAN,F.RACC(R3) ;IF RANDOM BIT IS SET BNE 13$ ;SET READ BIT TOO BITB #FA.CRE!FA.APD,F.FACC(R3) ;SHOULD FILE BE WRITE ONLY? BNE 12$ ;IF SO, SKIP READ SET 13$: BIS #400,R0 ;SET READ BIT 12$: BITB #FD.RAN,F.RACC(R3) ;RANDOM SPECIFIED? BEQ 5$ ;IF NOT, SKIP BIT SET BIS #2000,R0 ;SET RANDOM BIT 5$: BITB #FD.CR,F.RATT(R3) ;ASCII SET? BNE OPEN06 ;BRANCH IF SO BIS #4000,R0 ;SET BINARY BIT OPEN06: BISB F.LUN(R3),R0 ;SET FILE NUMBER IN CONTROL WORD DEC R0 ;STORE FILE NUMBER AS ONE LESS MOV R0,(R5)+ ;OUTPUT IT MOV R5,(R5) ;BUILD CHAR POINTER ADD #S.FDB+24,(R5)+ ;BUFFER AFTER FDB MOV OP.LEN,(R5)+ ;GET MAX BYTE COUNT (REC LEN) ADD #4,R5 ;SKIP OVER 2 LOCATIONS MOV -10(R5),(R5)+ ;SET DATA ADDRESS CMP (R5)+,(R5)+ ;SKIP TWO PLACES (LB ERR, FDB PTR) MOV OP.EOF,(R5)+ ;END OF FILE ROUTINE ADD #4,R5 ;SKIP OVER 2 UNUSED LOCATIONS MOV R5,R0 ;START OF FDB NOW IN R0 MOV #S.FDB,R2 ;# BYTES TO XFER IN R2 ASR R2 ;# WORDS TO XFER IN R2 3$: MOV (R3)+,(R5)+ ;HEAD 'EM UP SOB R2,3$ ;AND MOV 'EM OUT ADD #S.FDB,SP ;GET RID OF STACK FDB MOV -14(R0),F.URBD+2(R0) ;ADD OF REC BUFFER IN FDB MOV -22(R0),F.URBD(R0) ;LIKEWISE ITS LENGTH JSR PC,.OPEN ;NOW OPEN FILE MOVB F.ERR(R0),R0 ;ERROR CODE WITH SIGN EXTEND IN R0 MOV R0,PARLST+P.FCS ;PUT IN MO PARAMETER LIST BCC 8$ ;IF OPEN OK GO ADD BUFFER LEN MOV R4,R3 ;GET SET TO DELETE UNUSED FDB JSR PC,DELFDB ;DELETE FDB OPENER ;REPORT FCS ERROR 8$: MOV R4,STUFDB ;SAVE NEW FDB START JMP INIT02 ;GO TO NEXT STATEMENT OPEN02: MOVB #R.FIX,F.RTYP(R3) ;SET FIXED RECORD SIZE MOV #1000,F.RSIZ(R3) ;AND MAKE IT 1 BLOCK LONG MOV #1030+S.FDB,R0 ;SET SIZE OF FDB+BUFFER AND CONTROL TSTOK ;CHECK IT BHIS 1$ ;IF OK, BRANCH OVFERR ;ELSE ERROR 1$: JSR PC,CREFDB ;CREATE AN FDB REGION MOV R5,R4 ;COPY START OF NEW FDB REGION MOV FDBSAV,R3 ;GET START OF STACK FDB MOV #10400,R0 ;SET BLOCK MODDE AND READ ACCESS BITB #FA.WRT,F.FACC(R3) ;WAS WRITE SPEC'D? BEQ 2$ ;IF NOT, BRANCH BIS #1000,R0 ;IF SO, SET WRITE ACCESS 2$: MOV #1000,OP.LEN ;SET BUFFER LEN BISB #FD.RWM,F.RACC(R3) ;SET READ/WRITE IO (BLOCK MODE) MOVB #1,F.BKEF(R3) ;USE EVENT FLAG #1 FOR I/O SYNC BR OPEN06 ;AND BRANCH BACK TO MAIN LINE CODE CREFDB: MOV STGOSB,R2 ;START OF BLOCK TO MOVE MOV STUFDB,R3 ;END OF BLOCK TO MOVE JSR PC,SLDN ;SLIDE IT ALL DOWN R0 BYTES SUB R0,STGOSB ;AND ADJUST PTRS SUB R0,STFONX SUB R0,STUFDB MOV STUFDB,R5 ;GET START OF CURRENT BLOCK -> R5 MOV R5,-(SP) ;SAVE R5 ASR R0 ;WORD COUNT IN R0 2$: CLR (R5)+ ;CLEAR THE DATA AREA SOB R0,2$ ;AND BRANCH TILL DONE MOV (SP)+,R5 ;RESTORE OLD R5 RTS PC .SBTTL CLOS00 - USER FILE CLOSE ROUTINE ;+6 ; .SKIP ; .X ^^CLOSE\\ ; .X ^FILE CLOSE ; .HEADERLEVEL 1 ^^CLOSE N1[,N2...]\\ ; .BREAK ; ^THIS COMMAND CLOSES A USER DATA FILE WHOSE NUMBER IS ^N1, ^N2 ETC. ; ^NOTE THAT NO _# SIGN PRECEDES THE NUMBER. ; ^IF USED WITH NO FILE NUMBER, ALL USER FILES ARE CLOSED. ; .BREAK ; ^EXAMPLE: ; .NOFILL ; ^^ ; {60 CLOSE 4} ; {70 CLOSE I1} ; {95 CLOSE} ; \\ ; .FILL ;- CLSE00: SKIP CMPB R2,#S.EOS1 ;END OF STATEMENT? BHIS 2$ ;IF SO, ALL WANTED DEC R1 ;REDO LAST CHAR 1$: EVAL ;GET A FILE NUMBER BVS 4$ ;PAREN IS ERROR STCFI AC0,R4 ;GET FILE NUM DEC R4 ;ADJUST CMP #255.,R4 ;VALID?? BLO 4$ ;NOPE MOV #17400,R0 ;SET MASK JSR PC,CLSEIT ;GOTO CLOSE ROUTINE SKIP CMP #',,R2 ;MORE FILES?? BEQ 1$ ;GO DO IF SO BR 6$ ;EXIT ; ; CLOSE ALL FILES ROUTINE ; 2$: JSR PC,CLSEAL ;CALL CLOSER 6$: DEC R1 ;ADJUST TEXT POINTER JMP INIT02 ;NEXT STATEMENT 4$: CLSERR ;ERROR IN CLOSE ; ; ACTUAL CLOSE ROUTINE ; CLSEIT: JSR PC,SRCHFL ;SEARCH FOR FILE WHOSE NUMBER IS IN R4 BEQ 4$ ;BR NOT THERE (IGNORE REQUEST) BIT #10000,(R3) ;DO WE HAVE BLOCK MODE FILE? BEQ 2$ ;IF NOT, BRANCH JSR PC,WRITBK ;DO ANY NECESSARY WRITE BR 3$ ;AND GO BRANCH TO DIRECT CLOSE 2$: BIT #1000,@R3 ;THIS OUTPUT BEQ 5$ ;SKIP BUFF CHECK IF NOT BIT #2000,@R3 ;OR IF CONTIG BNE 5$ ;SKIP CHECK TST 10(R3) ;ANYTHING LEFT IN BUFFER?? BEQ 5$ ;OK IF NOT MOV R3,R0 ;SET REG TST (R0)+ ;ADJUST JSR PC,PRNT01 ;ELSE FORCE IT OUT 5$: MOV R3,R0 ;GET FDB ADDRESS ADD #26,R0 ;IN R0 3$: CLOSE$ ;AND CLOSE MOVB F.ERR(R0),R0 ;ERROR CODE WITH SIGN EXTEND IN R0 MOV R0,PARLST+P.FCS ;STORE IN MO PARAMETER LIST BCC 1$ ;IF NO ERROR, DON'T REPORT CLOSER ;REPORT FCS ERROR 1$: JSR PC,DELFDB ;DELETE THE FDB 4$: RTS PC ;AND RETURN CLSEAL: CLR R4 ;SEARCH FOR A FILE MOV #17777,R0 ;MASK JSR PC,CLSEIT ;DO A CLOSE BNE CLSEAL ;IF OK TRY FOR ANOTHER RTS PC ;ELSE RETURN ; ; ROUTINE DELFDB ; TO DELETE SPACE FOR BASIC FDB (INCL BUFFER AND POINTERS ETC.) ; ON ENTRY: ; R3 POINTS TO FDB TO BE DELETED ; ON EXIT: ; STUFDB,STGOSB,STFONX UPDATED ; REGISTERS USED: R0,R2 ; DELFDB: MOV 4(R3),R0 ;CALCULATE SIZE OF ADD #S.FDB+30,R0 ;BLOCK -> R0 MOV STGOSB,R2 ;START OF DATA TO BE MOVED -> R2 JSR PC,SLUP ;SLIDE IT UP ADD R0,STUFDB ;ADJUST PTRS ADD R0,STGOSB ADD R0,STFONX RTS PC ;AND RETURN ; ; ROUTINE SRCHFL - TO SEARCH FOR FILE WHOSE HEADER ; MATCHES R4 AND MASK TO IGNORE IN R0 ; PTR TO FCB -> R3 IF FOUND, 0 OTHERWISE ; SRCHFL: MOV STUFDB,R3 ;START OF FDB AREA -> R3 1$: CMP R3,ENDUSR ;AT END OF BASIC TASK AREA? BHIS 2$ ;IF SO, GO REPORT FAILURE MOV (R3),R2 ;HEADER -> R2 BIC R0,R2 ;CLEAR OUT MASK CMP R2,R4 ;MATCH? BEQ 3$ ;IF SO, GO RETURN SUCCESSFULLY ADD 4(R3),R3 ;OFFSET TO NEXT FDB ADD #S.FDB+30,R3 ; BR 1$ 2$: CLR R3 ;INDICATE FAILURE 3$: TST R3 ;TEST FOR SUCCESS OR FAILURE RTS PC ;AND RETURN .SBTTL FNMB00 - FILE NUMBER PROCESSOR ; ; FNMBR/FNMB00 - PROCESS FILE NUMBER, SETUP FILE BLOCK POINTERS ; FILFND: MOV R0,-(SP) ;SAVE IO TYPE EVAL ;GET NUMBER BVS FNMB99 ;PAREN IS ERROR MOV (SP)+,R0 ;RESTORE IO TYPE STCFI AC0,R4 ;GET NUMBER FILFN1: DEC R4 ;IN RANGE 0-255 CMP #255.,R4 ;VALID?? BLO FNMB99 ;NOPE BIS R0,R4 ;SET SEARCH MASK MOV #177400,-(SP) ;CALCULATE MASK TO IGNORE BIC R0,(SP) MOV (SP)+,R0 ;AND PUT IT IN R0 JSR PC,SRCHFL RTS PC FNMB00: SKIP CMP #'#,R2 ;FILE NUMBER THERE?? BEQ 1$ ;BR IF YES DEC R1 ;BACKUP POINTER RTS PC ;AND RETURN 1$: JSR PC,FILFND BEQ FNMB99 ;ERROR BR BIT #400,(R3)+ ;INPUT?? BEQ 2$ ;NOPE MOV R3,INPT ;SET INPUT POINTER 2$: BIT #1000,-2(R3) ;OUTPUT?? BEQ 5$ ;NOPE MOV R3,OTPT ;SET OUTPUT POINTER 5$: MOV R3,14(R3) ;SET UP PROPER FDB POINTER ADD #24,14(R3) ;IN I/O CONTROL BLOCK (WHICH MAY HAVE MOVED) MOV R3,10(R3) ;UPDATE DATA BUFFER ADDRESS PTR ADD #24+S.FDB,10(R3) MOV 10(R3),(R3) ;AND NEXT BYTE AVAIL PTR ADD 6(R3),(R3) SKIP ;BUMP R1 PAST COMMA CMPB R2,#', ;MAKE SURE IT IS COMMA BEQ 6$ ;AND CHECK THAT ACCESS IS SEQ. CMPB R2,#'' ;IS CHAR A SINGLE QUOTE BEQ 7$ ;IF SO, PROCESS CMPB R2,#'@ ;ALLOW THIS TYPE OF RECORD # INDICATOR BEQ 7$ DEC R1 ;OTHERWISE BACK UP TEXT POINTER BR 6$ ;AND MAKE SURE SEQUENTIAL 6$: BIT #2000,-2(R3) ;IS RANDOM BIT SET BNE FNMB98 ;IF SO, AN ERROR 3$: RTS PC ;RETURN 7$: BIT #2000,-2(R3) ;CHECK RANDOM BIT BEQ FNMB98 ;IF NOT SET, ACCESSM MODE ERROR MOV R3,-(SP) ;SAVE FCB POINTER EVAL ;EVALUATE THE RECORD NUMBER BVS FNMB99 ;IF ERROR, DO ERROR EXIT MOV (SP)+,R3 ;RESTORE FILE CONTROL BLOCK POINTER MOV 14(R3),R3 ;FDB ADDRESS IN R3 SETL STCFL AC0,F.RCNM(R3) ;STORE LONG RECORD NUMBER IN FDB SETI BLE FNMB99 ;NEG OR ZERO RECORD NUMBER IS ERROR SKIP ;GET NEXT NON-BLANK CHAR CMPB R2,#', ;CHECK FOR COMMA BNE FNMB99 ;IF NOT REPORT ERROR BR 3$ ;RETURN SUCCESSFULLY FNMB98: FACERR ;FILE ACCESS MODE ERROR (RAN/SEQ) FNMB99: FNMERR .SBTTL PRLN00 - PRINT LINE NUMBER ; ; PRNTLN - PRLN00 - PRINT LINE NUMBER ; REGISTERS USED - R0,R1,R2. ; PRLN00: MOV LINENO,R1 ;CURRENT LINE NUMBER -> R1 PRLN01: SUB #10,SP ;DESTINATION MOV SP,R0 ; IS ON THE STACK ITOA ;CONVERT TO ASCII MOV SP,R0 ;PRINT THE RESULTING PRINTL ;PRINT NUMBER ADD #10,SP ;RESTORE THE STACK RTS PC .SBTTL GET00 - GET LINE LIMITS FOR COMMAND (LIST OR DELETE) ; ; GET00 - GET LINE LIMITS FOR COMMAND (LIST OR DELETE) ; ON ENTRY: ; R1 POINTS TO START OF PARAMETERS ; ON EXIT: ; R1 POINTS PAST END OF THIS SET OF PARAMS ; R3 HAS ADDRESS OF LOWEST LINE # HEADER IN RANGE ; R4 HAS ADDRESS OF HIGHEST INCLUDED LINE # HEADER ; 'Z' SET IF NO LINES INCLUDED IN RANGE ; OTHER REGISTERS USED: R0,R2,R5 (ALL) ; GET00: SKIP ;GET 1ST CHAR CMPB R2,#'* ;ASKING FOR LAST LINE? BNE 1$ ;IF NOT, BRANCH MOV BOLNHD,R3 ;POINT TO LAST LINE CMP R3,STUDAT ;DO WE REALLY HAVE ANYTHING? BHIS 7$ ;IF NOT, BRANCH MOV (R3),R0 ;INDICATE EXACT MATCH BR 8$ 1$: DEC R1 ;BACK UP ONE CHAR ATOI ;GET NUMBER -> R0 MOV R1,-(SP) ;SAVE TEXT PTR FINDLN ;FIND THE LINE BEQ 2$ ;IF EXACT MATCH, BRANCH SUB #4,R5 ;ELSE POINT TO 1ST INCLUDED HEADER 2$: MOV R5,R3 ;COPY POINTER -> R3 MOV (SP)+,R1 ;RESTORE TEXT PTR 8$: SKIP ;NEXT CHAR -> R2 CMPB R2,#'- ;DO WE WANT RANGE? BEQ 4$ ;IF SO, BRANCH DEC R1 ;BACK UP TEXT PTR TST R0 ;CHECK FOR LINE # 0 BNE 3$ ;IF NOT, BRANCH MOV BOLNHD,R4 ;IF SO, IT WAS A PLAIN LIST, SO INCLUDE ALL BR 6$ ;GO TO FINAL CHECK 3$: CMP R0,(R3) ;EXACT MATCH? BNE 7$ ;IF NOT, BRANCH TO NO TEXT FINISH MOV R3,R4 ;COPY START -> END BR 6$ ;GO TO FINAL CHECK 4$: SKIP CMPB R2,#'* ;LAST LINE ASKED? BNE 5$ ;IF NOT, BRANCH MOV BOLNHD,R4 ;PUT LAST LINE HEADER -> R4 BR 6$ ;GO TO FINAL CHECK 5$: DEC R1 ;BACK UP ONE CHAR ATOI ;GET SECOND LINE # -> R0 MOV R1,-(SP) ;SAVE OUR TEXT PTR FINDLN ;FIND THE HEADER -> R5 MOV R5,R4 ;COPY -> R4 (NO MATTER IF EXACT MATCH) MOV (SP)+,R1 ;RESTORE TEXT PTR 6$: CMP R3,R4 ;SEE IF ACTUAL RANGE EXISTS BLO 7$ ;IF NOT, BRANCH CLZ ;MAKE SURE NO 'Z' (SUCCESS) RTS PC ;AND RETURN 7$: SEZ ;SET NO TEXT (FAILURE) RTS PC .SBTTL LIST00 - LIST THE SOURCE TEXT ;+2 ; .SKIP ; .X ^^LIST\\ ; .X ^PROGRAM LIST ; .HEADERLEVEL 1 ^^LIST [N1][-N2][,N3...]\\ ; .BREAK ; ^THIS IS PRIMARILY AN IMMEDIATE MODE COMMAND. ; ^WITH NO ARGUMENTS, THE WHOLE PROGRAM IS LISTED AT THE USER'S ; TERMINAL. ; ^SINGLE ARGUMENTS SEPARATED BY COMMAS WILL LIST ONLY THE ; LINE NUMBERS REQUESTED. ; ^TWO ARGUMENTS SEPARATED BY A DASH (MINUS) WILL LIST AN INCLUSIVE ; LINE NUMBER RANGE. ; .BREAK ; ^EXAMPLE: ; .NOFILL ; ^^ ; {LIST} ; {LIST 20} ; {LIST 50,100} ; {LIST 50-80,135,710-750} ; \\ ; .FILL ;- ; REGISTERS USED - R1,R2,R3,R4,R5 ; LIST00: JSR PC,ATTACH ;ATTACH TERMINAL (FOR ^O) 1$: JSR PC,GET00 ;GET LINE HEADER RANGE BEQ 31$ ;IF NONE, BRANCH MOV R1,-(SP) ;SAVE TEXT PTR MOV R4,-(SP) ;SAVE FINAL HEADER ADDRESS MOV R3,R5 ;INITIAL HEADER ADD -> R5 2$: CMP R5,(SP) ;PAST END OF RANGE YET? BLO 3$ ;IF SO, BRANCH JSR PC,4$ ;GO DO THIS LINE TSTB BRFLAG ;HAS USER TRIED TO BREAK? BNE 32$ ;IF SO, BRANCH TO STOP LISTING SUB #4,R5 ;POINT TO NEXT HEADER BR 2$ ;AND GO AROUND AGAIN 3$: TST (SP)+ ;POP FINAL HEADER ADDRESS MOV (SP)+,R1 ;RESTORE TEXT PTR 31$: SKIP ;NEXT CHAR OF PARAMS CMPB R2,#', ;COMMA SEPARATING SETS OF NUMBERS? BEQ 1$ ;IF SO, DO IT AGAIN DEC R1 ;ELSE BACK UP TEXT PTR CLOSEF ;CLOSE FILE IF OPEN JSR PC,DETACH ;DETACH TERMINAL (NULLIFY ^O) JMP INIT02 ;AND GO GET NEXT STATEMENT 32$: ADD #4,SP ;ADJUST STACK JMP STOP00 ;AND DO A STOP SO WE KNOW IT'S ^C ; ; SUBROUTINE TO PRINT OUT LINE WHOSE HEADER ; IS POINTED TO BY R5 ; 4$: MOV (R5),R1 ;GET LINE NUMBER -> R1 JSR PC,PRLN01 ;PRINT IT MOV 2(R5),R1 ;SET UP TEXT PTR ADD USR,R1 ;ADD IN BASE ADDRESS 5$: MOVB (R1)+,R2 ;NEXT CHAR -> R2 CMPB R2,#S.EOL1 ;END OF STATEMENT OR LINE? BHIS 15$ ;IF SO, BRANCH BIT #2,REMTRM ;COMPILED PROG.? BNE 14$ ;IF SO, CAN SKIP SOME CODE BIC #177400,R2 ;CLEAR SIGN EXTEND CMPB R2,#140 ;A TOKEN? BLO 14$ ;IF NOT, BRANCH CLR -(SP) ;SET NO FLAG FOR SURROUNDING BLANKS CMPB R2,#S.VBEN ;ARE WE IN VERBS PROPER? BLOS 6$ ;IF SO, BRANCH TO SET FLAG CMPB R2,#S.THEN ;MIGHT BE IN OTHER TOKENS WITH BLANKS BLO 7$ ;IF NOT, BRANCH (DON'T SET FLAG) 6$: INC (SP) ;SET SURROUNDING BLANKS FLAG 7$: MOV #INIT11,R0 ;START OF PROTOTYPES -> R0 SUB #140,R2 ;MAKE R2 INTO LOOP COUNTER BEQ 9$ ;IF ZERO, SKIP LOOP TO FIND PROTOTYPE TEXT 8$: TSTB (R0)+ ;SKIP THROUGH A PROTOTYPE BNE 8$ ; SOB R2,8$ ;R2 TIMES 9$: TST (SP) ;SURROUNDING BLANKS? BEQ 10$ ;IF NOT, BRANCH MOVB #40,R2 ;IF SO, PRINT LEADING BR 11$ ;BLANK 10$: MOVB (R0)+,R2 ;GET NEXT PROTOTYPE CHAR BEQ 12$ ;IF AT END, BRANCH 11$: PRINTC ;PRINT THE CHARACTER BR 10$ ;AND LOOK FOR ANOTHER 12$: TST (SP)+ ;POP SURROUNDING BLANK FLAG BEQ 13$ ;IF NONE, DON'T PRINT CHAR MOVB #40,R2 ;IF ONE, PRINT IT 14$: PRINTC 13$: BR 5$ ;AND GO BACK FOR MORE PROGRAM TEXT 15$: MOV R2,R0 ;COPY TERM CHAR NEG R0 ;MAKE IT POS. ASL R0 ;MPY BY TWO FOR WORD OFFSET JMP @16$-2(R0) ;AND GO TO APPROPRIATE PLACE 16$: .WORD 17$ ;EOL2 .WORD 18$ ;EOS2 .WORD 19$ ;EOS1 .WORD 17$ ;EOL1 18$: MOVB #S.CON2,R0 ;PUT IN CONCATENATION CHAR BR 20$ 19$: MOVB #S.CON1,R0 ;PUT IN 1ST TYPE CONCATENATION CHAR 20$: BIT #2,REMTRM ;SAVING COMPILED MODE? BNE 14$ ;IF SO, BRANCH MOV R0,R2 ;IF NOT, COPY ASCII CHAR BR 14$ 17$: CRLF ;DO END OF LINE CMPB R2,#S.EOL2 ;WAS THIS END OF LOGICAL LINE? BNE 5$ ;IF NOT, PRINT MORE RTS PC ;ELSE RETURN .SBTTL DEL00 - DELETE TEXT IN USER PROGRAM ;+2 ; .SKIP ; .X ^^DELETE\\ ; .X ^PROGRAM LINE DELETE ; .HEADERLEVEL 1 ^^DELETE N1[-N2][,N3...]\\ ; .BREAK ; ^THIS ALSO IS PRIMARILY AN IMMEDIATE MODE COMMAND. ; ^IT WILL DELETE INDIVIDUAL LINES WITH SINGLE PARAMETERS OR INCLUSIVE ; RANGES WITH NUMBERS SEPARATED BY A DASH (MINUS). ; ^IF NO NUMBERS ARE SPECIFIED, THE WHOLE PROGRAM TEXT IS DELETED (BUT NOT ; PROGRAM DATA - THIS MUST BE DONE WITH THE ^^CLEAR\\ COMMAND). ; ^IT CAN BE USED IN PROGRAM MODE ALSO, USUALLY TO DELETE A RANGE OF ; LINE NUMBERS IN PREPARING TO R0 MOV R1,-(SP) ;SAVE A REGISTER MOV 2(R3),R1 ;MAKE R1 POINT TO ADD USR,R1 ;START OF DEST FOR BLOCK MOVE MOV -2(R4),R2 ;CALCULATE # OF BYTES TO ADD USR,R2 ;MOVE IN R0 AND SUB R2,R0 ;START OF BLOCK ADD -> R2 BEQ 4$ ;IF ZERO, BRANCH 3$: MOVB (R2)+,(R1)+ ;DO THE MOVE SOB R0,3$ 4$: SUB R1,R2 ;R2 HAS DISTANCE WE MOVED MOV R1,ENDTXT ;RECORD NEW END OF TEXT MOV (SP)+,R1 ;RESTORE R1 MOV R2,-(SP) ;SAVE DISTANCE OF TEXT MOVE MOV R3,-(SP) ;SAVE R3 (TOP OF HEADER) AREA TO BE DELETED MOV BOLNHD,R2 ;BOTTOM OF BLOCK OF HEADERS TO BE MOVED MOV R3,R0 ;R0 TEMPORARILY HAS NEW ADD #4,R0 ;TOP ADDRESS TO MOVE TO MOV R4,R3 ;GET OLD TOP ADDRESS -> R3 MOV R0,R4 ;NEW TOP -> R4 JSR PC,SLUP01 ;SLIDE UP THE REMAINING HEADERS MOV R4,BOLNHD ;SET NEW BOTTOM OF HEADERS MOV (SP)+,R5 ;POINTS TO START OF HEADERS TO BE ADJUSTED MOV (SP)+,R0 ;COUNT OF DISTANCE MOVED MOV 2(R5),R2 ;SEE IF TEXT POINTER FOR ADD USR,R2 ;DELETE INSTRUCTION WAS IN CMP R1,R2 ;MOVED CODE BLO 5$ ;IF NOT, BRANCH SUB R0,R1 ;IF SO, ADJUST IT 5$: CMP R5,BOLNHD ;FINISHED WITH ADJUSTING? BLO 6$ ;IF SO, BRANCH SUB R0,2(R5) ;ADJUST TEXT PTR FOR EACH LINE SUB #4,R5 ;THAT WAS MOVED BR 5$ ;AND KEEP GOING 6$: SKIP ;GET NEXT CHAR IN DELETE COMMAND CMPB R2,#', ;IS IT A COMMA (MORE)? BEQ 1$ ;IF SO, DO IT DEC R1 ;ELSE BACK IT UP JMP INIT02 ;AND GO ON WITH PROGRAM .SBTTL INIT00, INIT02 - STATEMENT INTERPRETER ; ; PDP-11 BASIC - COMMAND/STATEMENT INTERPRETER ; REGISTERS USED - R0,R1,R2,R3,R4,R5 ; INIT02: ;DSS1 .IF DF,FPPEMU ;IF FPP EMULATION ;DSS1 .IFF ;IF NOT ;DSS1 TST FPEXFL ;ANY FLOATING POINT ERRORS? ;DSS1 BEQ 1$ ;IF NOT, SKIP SUBROUTINE ;DSS1 .IFTF ;EITHER WAY ;DSS1 JSR PC,FPERMS ;IF SO, PROCESS THEM ;DSS1 .ENDC ;DSS1 ;DSS1 1$: SKIP ;GET THE NEXT CHARACTER ;**-3 INIT03: CMPB R2,#S.EOL1 ;AT END OF STATEMENT? BLO 4$ ;IF NOT, ERROR COM R2 ;MAKE TERMINATOR INTO A JUMP ASL R2 ;POINTER JMP @2$(R2) ;AND GO TO ROUTINE 2$: .WORD 3$ ;S.EOL2 .WORD INIT20 ;S.EOL1 .WORD INIT20 ;S.EOS .WORD 8$ ;S.EOL1 4$: CMPB R2,#S.ELSE ;AN ELSE TOKEN? BNE 5$ ;IF NOT, BRANCH SRCHLF ;IF SO, SKIP TO END OF LOGICAL LINE BR 3$ ;AND CONTINUE ON IN INTERPRETER 5$: CMPB R2,#S.EXC ;EXCLAMATION TYPE REMARK? BNE 6$ ;IF NOT, BRANCH TO ERROR JMP REM00 ;GO TO REMARK PROCESSING 8$: MOV R1,-(SP) ;SAVE STACK PTR SKIP ;GET FIRST SIGNIFICANT CHAR -> R2 CMPB R2,#S.EXC ;DOES LINE START WITH COMMENT? BEQ 9$ ;IF SO, BRANCH MOV (SP)+,R1 ;GET BACK TEXT PTR BR INIT20 ;AND DO NORMAL STATEMENT 9$: MOV (SP)+,R1 ;GET BACK TEXT PTR BR INIT10 ;AND DO REMARK WITHOUT COUNTING IT 6$: ILCERR ;ILLEGAL CHARACTER TERMINATING STMT. 3$: TSTB QFLG ;CHECK FOR 1 LINE MCR PRINT BEQ 7$ ;IF SO JMP PCK11 ;EXIT 7$: TST RUNF ;IS RUN MODE SET ;DSS1 BEQ INIT19 ;JUMP IF NOT ;DSS1 MOV LINEHD,R5 ;GET CURRENT LINE HEADER ;DSS1 SUB #4,R5 ;AND POINT TO NEXT LINE HEADER ;DSS1 INIT13: TST BRFLAG ;SEE IF BREAK SET ;DSS1 BNE INIT26 ;IF SET, STOP ;DSS1 CMP R5,BOLNHD ;AT END OF PROGRAM? ;DSS1 BLO INIT26 ;IF SO, BRANCH ;**-7 MOV R5,LINEHD ;ESTABLISH NEW CURRENT LINE HEADER MOV (R5),LINENO ;AND NEW CURRENT LINE NUMBER MOV 2(R5),R1 ;AND TEXT POINTER ADD USR,R1 ;ADD IN OFFSET CLR STCOUN ;SET STATEMENT COUNT TO ZERO INIT20: INC STCOUN ;INCREMENT STATEMENT POSITION COUNT INIT10: MOV ENDTXT,R3 ;CURRENT END OF TEXT -> R3 INC R3 ;ROUND IT UP TO BIC #1,R3 ;NEXT WORD BOUNDARY CMP R3,BOLNHD ;DOES IT MATCH BOTTOM OF LINE HEADERS? BEQ 2$ ;IF SO, SKIP THE MOVE MOV BOLNHD,R2 ;START OF BLOCK TO MOVE -> R2 MOV R2,R0 ;CALCULATE DISTANCE TO SUB R3,R0 ;MOVE IN R0 MOV ENUDAT,R3 ;END OF BLOCK TO MOVE -> R3 JSR PC,SLDN ;SLIDE IT ALL DOWN SUB R0,BOLNHD ;AND ADJUST THE POINTERS SUB R0,STUDAT ;INVOLVED SUB R0,ENUDAT TST LINEHD ;NON-ZERO LINEHD (PROGRAM MODE)? BEQ 2$ ;IF NOT, DON'T DO ANYTHING SUB R0,LINEHD ;IF SO, ADJUST IT TOO! 2$: MOV ENUDAT,ENUSAV ;SAVE END OF USER DATA IN CASE ERROR SKIP ;GET VERB BIC #177400,R2 ;CLEAR SIGN EXTEND SUB #S.BAS,R2 ;GET ADDRESS DISPLACEMENT BGE 1$ ;IF REGULAR CODE, PROCEED DEC R1 ;ELSE IMPLIED LET JMP LET00 1$: CMP R2,#S.VBEN-S.BAS ;ARE WE IN VERB RANGE? BHI 3$ ;IF NOT, BRANCH TO ANOTHER CHECK ASL R2 MOV #TINPT,INPT ;SET FILE CONTROL BLOCK POINTERS MOV #TOTPT,OTPT JMP @INIT12(R2) ;GO DO IT 3$: CMPB R2,#S.ELSE-S.BAS ;DO WE HAVE ELSE TOKEN BNE 4$ ;IF NOT, ERROR (BRANCH) SRCHLF ;IF SO, IGNORE IT ALL DEC R1 ;BACK UP TEXT PTR JMP INIT02 ;AND START OVER AGAIN 4$: CMPB R2,#S.EOL2-S.BAS ;ARE WE AT END OF LINE (FROM REMARK TRIM)? BNE 5$ ;IF NOT, ERROR (BRANCH) MOVB #S.EOL2,R2 ;IF SO, RESTORE R2 (SIGN EXTEND AND ALL) JMP INIT03 ;AND GO AROUND AGAIN 5$: UNRERR INIT26: JMP STOP00 INIT19: MOV #TINPT,INPT ;RESET INPUT AND OUTPUT MOV #TOTPT,OTPT ;IN CASE IMMEDIATE I/O WITH FILE INIT00: CLR RUNF ;CLEAR RUN FLAG TO START CLR BRFLAG ;CLEAR THE BREAK FLAG MOV #RDY00,R0 ;TELL USER THAT PRINTL ;ALL IS READY INIT04: PACK ;GET A COMMAND INIT01: MOV R1,WORK ;SAVE INITIAL TEXT POINTER SKIP ;GET THE FIRST CHARACTER CMP R2,#S.EOL2 ;IGNORE IF ONLY A TERMINATOR BEQ INIT04 MOV WORK,R1 ;GET TEXT POINTER ATOI ;GET INTERNAL LINE NUMBER MOV R1,R3 ;TEST ADDRESS ALSO IN R3 CMPB @R1,#S.EOL2 ;CALL IT A DELETE IF NO BNE INIT08 FINDLN ;FIND THE LINE NUMBER BNE INIT04 ;NO SUCH LINE SQUISH ;FOUND,DELETE IT BR INIT04 INIT08: BIT #2,REMTRM ;COMPILED FILE? BEQ INIT05 ;IF NOT, DO REGULAR INTERPRETATION 1$: CMPB (R1)+,#S.EOL2 ;LOOK FOR END OF LINE BNE 1$ DEC R1 ;BACK UP TEXT POINTER JMP INIT06 ;AND SKIP THE INTERPRETATION ; ; THIS SECTION TAKES THE BUFFER POINTED TO BY R1 AND R3 AND COMPACTS IT. ; IN EFFECT, R1 IS A LEFT BUFFER POINTER AND R3 IS A RIGHT BUFFER POINTER. ; INIT05: MOV #INIT11,R0 ;START OF VERB AND TOKEN PROTOTYPES -> R0 12$: CMPB (R3),#40 ;IS CURRENT CHAR A SPACE? BNE 13$ ;IF NOT, BRANCH 14$: MOVB (R3)+,(R1)+ ;IF SO, MOVE IT INTO LEFT BUFFER BR 12$ ;AND KEEP LOOKING FOR NON-SPACE 13$: CMPB (R3),#'" ;IS THIS START OF QUOTED STRING? BEQ 7$ ;IF SO, GO PROCESS STRING CMPB (R3),#S.CON1 ;DO WE HAVE COLON? BNE 22$ ;IF NOT, BRANCH MOVB #S.EOS1,(R1)+ ;IF SO, REPLACE IT WITH EOS TOKEN INC R3 ;AND PUSH UP LINE MARKER BR 12$ ;GO AROUND FOR MORE 22$: CMPB (R3),#S.CON2 ;OTHER TYPE OF STATEMENT TERMINATOR? BNE 23$ ;IF NOT, BRANCH MOVB #S.EOS2,(R1)+ ;IF SO, PUT IN SPECIAL TOKEN INC R3 BR 12$ 23$: CMPB (R3),#S.EOL2 ;END OF LINE? BEQ INIT06 ;IF SO, GO TO NEXT SECTION OF CODE ; ; NEXT SECTION OF CODE DOES CHECK FOR ALPHA CHAR. IF NOT, WE CAN SAVE ; SOME PROCESSING SINCE ALL PROTOTYPES START WITH AN ALPHA, ! OR ? ; MOVB (R3),R4 ;CHAR -> R4 CMPB R4,#'? BLO 15$ CMPB R4,#'Z BLOS 16$ 15$: CMPB R4,#'! ;THIS IS THE OTHER POSSIBILITY BNE 14$ ;IF NOT, NOT START OF PROTOTYPE MOVB #S.EXC,R2 ;SAVE OURSELVES SOME TIME THIS WAY INC R3 ;ADJUST RIGHT BUFFER CLR -(SP) ;DUMMY TO KEEP STACK STRAIGHT BR 20$ ;AND GO FINISH LINE WITH NO FANCY STUFF ; 16$: CLR R2 ;INITIALIZE TOKEN COUNTER 11$: MOV R3,-(SP) ;SAVE RIGHT BUFFER POINTER 1$: CMPB (R3),#S.EOL2 ;IS IT END OF LINE? BEQ 4$ ;IF SO, NO TOKEN MATCH (BRANCH) 2$: CMPB (R0),#40 ;IS PROTOTYPE CHAR A SPACE? BNE 3$ ;IF NOT, BRANCH 26$: CMPB (R3)+,#40 ;SKIP OVER SPACES IN TEXT BEQ 26$ DEC R3 ;BACK UP TO FIRST NON-BLANK 27$: CMPB (R0)+,#40 ;SKIP OVER ALL SPACES IN PROTOTYPE BEQ 27$ DEC R0 ;AND BACK UP TO FIRST NON-BLANK 3$: CMPB (R0)+,(R3)+ ;DO PROTOTYPE & TEXT MATCH? BNE 4$ ;IF NOT, GO TRY FOR NEXT PROTOTYPE TSTB (R0) ;END OF PROTOTYPE? BNE 1$ ;KEEP TRYING ADD #140,R2 ;FORM TOKEN 20$: CMPB R2,#S.VBEN ;IS THIS A VERB PROPER? BLOS 21$ ;IF SO, BRANCH CMPB R2,#S.THEN ;ARE WE IN TOKENS NEEDING SPACES? BLO 19$ ;IF NOT, BRANCH 21$: CMPB -1(R1),#40 ;IS PRECEDING CHAR A SPACE? BNE 18$ ;IF NOT, BRANCH DEC R1 ;IF SO, CAN ELIMINATE SPACE 18$: CMPB (R3),#40 ;IS FOLLOWING CHAR A SPACE? BNE 19$ ;IF NOT, BRANCH INC R3 ;IF SO, CAN ELIMINATE IT TOO! 19$: MOVB R2,(R1)+ ;PUT IT INTO LEFT JUSTIFIED BUFFER TST (SP)+ ;CLEAN STACK CMPB R2,#S.DATA ;DATA STATEMENT? BEQ 17$ ;IF SO, NO FURTHER TOKEN SEARCH CMPB R2,#S.EXC ;EXCLAMATION TYPE REMARK? BEQ 25$ CMPB R2,#S.REM ;STD REM? BEQ 25$ BR INIT05 ;AND CONTINUE ON IN LINE 4$: MOV (SP)+,R3 ;RESTORE RIGHT BUFFER PTR 5$: TSTB (R0)+ ;SKIP TO END OF PROTOTYPE BNE 5$ CMP R0,#PROTEN ;END OF TOKEN PROTOTYPES? BHIS 6$ ;IF SO, BRANCH INC R2 ;ELSE INCREMENT TOKEN COUNTER BR 11$ ;AND GO TRY AGAIN 6$: MOVB (R3)+,(R1)+ ;PUT IN CURRENT CHAR (RT -> LT) BR INIT05 ;AND START OVER 7$: MOVB (R3)+,(R1)+ ;PUT IN OPEN QUOTE 9$: MOVB (R3)+,R4 ;GET NEXT CHAR CMPB R4,#S.EOL2 ;END OF LINE? BNE 8$ ;IF NOT, BRANCH UNMERR ;IF SO, UNMATCHED QUOTES ERROR 8$: CMPB R4,#'" ;END OF QUOTE? BEQ 10$ ;IF SO, BRANCH MOVB R4,(R1)+ ;IF NOT, PUT IN CHAR BR 9$ ;AND KEEP GOING 10$: MOVB R4,(R1)+ ;PUT IN CLOSE QUOTE BR INIT05 17$: MOVB (R3)+,R4 ;THIS SECTION MOVES REST OF CMPB R4,#S.EOL2 ;RIGHT BUFFER INTO LEFT BUFFER BEQ INIT06 ;LOOKING FOR MOVB R4,(R1)+ ;BUT WITH NO TOKEN SEARCH BR 17$ 25$: BIT #1,REMTRM ;DOING REMARK TRIM? BEQ 17$ ;IF NOT, BRANCH INIT06: MOVB #S.EOL2,(R1)+ ;MAKE END OF LINE MOV R1,R3 ;END OF LINE -> R3 MOV WORK,R1 ;START OF LINE -> R1 ATOI ;GET LINE # -> R0 TST R0 ;CHECK LINE # BNE 11$ ;IF NON-ZERO, BRANCH MOV WORK,R1 ;ELSE RESTORE LEADING SPACES AND BLANKS 11$: SUB R1,R3 ;CALCULATE LEN WITHOUT LINE NUMBER MOV R1,WORK ;AND REMEMBER START WITHOUT LINE # 8$: TST R0 ;ANY NON-ZERO LINE NUMBER? BNE ASSM00 ;IF SO, PUT IT INTO PROGRAM CMPB (R1),#40 ;LEADING CHAR A SPACE? BEQ 12$ ;IF SO, BRANCH CMPB (R1),#11 ;OR A TAB? BEQ 12$ ;ALSO BRANCH IF SO TST OLDFLG ;IMMEDIATE MODE COMMAND IN FILE PROGRAM ? BEQ 122$ ;NO CLR OLDFLG ;YES, CONSIDER IT AN ERROR IMMERR ;IMMEDIATE MODE DURING FILE INPUT AN ERROR 122$: CLOSEF ;ELSE CLOSE OFF OLD FILE JMP INIT10 ;AND DO COMMAND 7$: MOVB #S.EOL2,(R1)+ ;PUT IN END OF LINE TO TRIM REMARK SHORT MOV R1,R3 ;NOW RE-CALCULATE REMARK MOV WORK,R1 ;RE-ESTABLISH START SUB R1,R3 ;R3 NOW HAS LENGTH (SHORTENED) BR 8$ ;AND BRANCH BACK TO REGULAR CODE 12$: BIT #1,REMTRM ;TRIMMING REMARKS BEQ ASSM00 ;IF NOT, GO ASSEMBLE STRAIGHTFORWARD SKIP ;GET NEXT CHAR CMPB R2,#S.EXC ;EXCLAMATION TYPE REMARK BEQ 13$ ;IF SO, BRANCH CMPB R2,#S.REM ;STANDARD REMARK BEQ 13$ ;IF SO, ALSO BRANCH MOV WORK,R1 ;RE-ESTABLISH START OF LINE BR ASSM00 ;AND ASSEMBLE LINE 13$: JMP INIT04 ;IF CONTINUED REMARK DOING TRIM, IGNORE SKPQT: CMPB (R1),#'" ;START OF STRING CONSTANT? BEQ 1$ ;IF SO, BRANCH RTS PC ;ELSE RETURN 1$: INC R1 ;PUSH POINTER TO NEXT CHAR CMPB (R1),#'" ;END OF QUOTE? BEQ 2$ ;IF SO, RETURN CMPB (R1),#S.EOL1 ;END OF STATEMENT OR PHYSICAL LINE? BLO 1$ ;IF NOT, BRANCH UNMERR ;IF SO, UNMATCHED QUOTES 2$: INC R1 RTS PC .SBTTL ASSM00 - ASSEMBLE LINE OF USER CODE ; ; ASSEMBLE LINE OF CODE INTO WORKING STORAGE - TRANSFER TO USER AREA ; REGISTERS USED - R0,R1,R2,R3,R4. ; UPUSRD: CMP ENUDAT,STGOSB ;AT TOP ALREADY? BHIS 3$ ;IF SO, WE'RE DONE MOV R3,-(SP) ;SAVE R3 MOV STGOSB,R4 ;NEW TOP -> R4 MOV BOLNHD,R2 ;OLD START -> R2 MOV ENUDAT,R3 ;OLD TOP -> R3 MOV R4,R0 ;CALC DISTANCE TO MOVE SUB R3,R0 ;IN R0 JSR PC,SLUP01 ;SLIDE IT UP MOV (SP)+,R3 ;RESTORE R3 4$: ADD R0,ENUDAT ;SAVE NEW END OF USER DATA MOV ENUDAT,ENUSAV ;AND ERROR RECOVERY END OF USER DATA ADD R0,STUDAT ;AND START ADD R0,BOLNHD ;AND BOTTOM OF LINE HEADERS 3$: RTS PC ASSM00:: ;DSS1 MOV R3,-(SP) ;SAVE LEN OF LINE ;DSS1 MOV R0,-(SP) ;AND LINE NUMBER ;DSS1 ;DSS1 555$: JSR PC,UPUSRD ;MOVE UP LINE NUMBERS ;DSS1 MOV BOLNHD,R0 ;NOW CHECK FOR ;**-4 SUB ENDTXT,R0 ;ROOM SUB #4,R0 ;FOR NEW CMP R0,2(SP) ;LINE BGT 2$ ;IF OK, BRANCH ;DSS1 ;DSS1 .IF DF,IASEXT ! M11EXT ;IF SELF-EXTENDING ;FRB3.2 JSR PC,EXTEND ;TRY TO GET MORE ROOM ;DSS1 BCC 555$ ;!!GOT IT!!---NOW GO INSERT LINE ;DSS1 .ENDC ;DSS1 ;DSS1 OVFERR ;ELSE ERROR (OVERFLOW) ;**-1 2$: MOV (SP),R0 ;LINE # -> R0 BNE 8$ ;IF A LINE WITH NUMBER, BRANCH MOV LSTLIN,R0 ;IF NOT, USE PREVIOUS LINE BNE 11$ ;IF THERE, BRANCH (OK) LINERR ;ELSE ERROR 11$: INC R0 ;LOOK FOR NEXT HIGHER LINE FINDLN ;FIND IT BNE 10$ ;IF EXACT MATCH, BRANCH ADD #4,R5 ;ELSE ADJUST R5 PTR 10$: MOVB #S.EOL1,-1(R1) ;PUT END OF PHYSICAL LINE IN PREVIOUS LINE TST (SP)+ ;CLEAN STACK BR 9$ ;AND SKIP SOME OTHER STUFF 8$: FINDLN ;GET LINE BNE 1$ ;IF NOT ALREADY THERE, BRANCH SQUISH ;IF IT'S THERE, DELETE IT (REGISTERS NOW SET) 1$: MOV R5,R3 ;COPY HEADER INSERTION POINT MOV BOLNHD,R2 ;BOTTOM OF HEADER AREA -> R2 MOV #4,R0 ;SLIDE THAT RANGE DOWN JSR PC,SLDN ;BY FOUR BYTES (ONE HEADER'S WORTH) SUB R0,BOLNHD ;AND ADJUST POINTER TO AREA SUB R0,R5 ;AND MAKE R5 POINT TO HOLE WE CREATED MOV (SP)+,(R5) ;PUT IN LINE NUMBER MOV (R5),LSTLIN ;RECORD LAST LINE ENTERED MOV R1,2(R5) ;AND ADDRESS OF LINE TEXT SUB USR,2(R5) ;MAKE IT AN OFFSET INTO TEXT AREA 9$: MOV (SP),R3 ;GET LENGTH OF LINE (MINUS LINE NUMBER) CMP R1,ENDTXT ;IS INSERTION POINT AT THE END BEQ 6$ ;IF SO, WE CAN SKIP SOME CODE 3$: SUB #4,R5 ;POINT TO NEXT HEADER CMP R5,BOLNHD ;PAST END YET? BLO 4$ ;IF SO, BRANCH ADD R3,2(R5) ;IF NOT, ADJUST ALL THE HIGHER LINE PTRS BR 3$ 4$: MOV ENDTXT,R4 ;SET UP TO MOVE TEXT UP MOV R4,R2 ADD R3,R2 ;GET NEW END -> R2 MOV R4,R0 ;CALCULATE # BYTES TO MOVE SUB R1,R0 ;IN R0 BEQ 6$ 5$: MOVB -(R4),-(R2) ;MOVE IT ALL UP SOB R0,5$ 6$: MOV (SP)+,R3 ;GET LENGTH OF NEW TEXT AGAIN ADD R3,ENDTXT ;UPDATE END OF TEXT MOV WORK,R2 ;ADDRESS OF TEXT -> R2 7$: MOVB (R2)+,(R1)+ ;MOVE IT ALL SOB R3,7$ ;IN JMP INIT04 ;AND GO GET NEXT LINE .SBTTL DATASET ERROR ROUTINES ; ; DATASET ERROR ROUTINES ; OLDFER: SCRFER: SAVFER: CLR REMTRM ;CLEAR SOME FLAGS MOV #COMFDB,R0 ;ADDRESS OF FDB -> R0 MOVB F.ERR(R0),R0 ;FCS ERROR CODE -> R0 MOV R0,PARLST+P.FCS ;STORE IN MO LIST PRFERR ;AND GO TO NORMAL ERROR HANDLING .SBTTL STATEMENT LIST ; ; DEFINITIONS OF LINE AND STATEMENT TERMINATORS S.EOL1 =374 ;END OF PHYSICAL LINE (BUT NOT LOGICAL LINE) S.EOS1 =375 ;1ST TYPE OF STATEMENT TERMINATOR S.EOS2 =376 ;2ND TYPE OF STATEMENT TERMINATOR S.EOL2 =377 ;END OF LOGICAL LINE (MAY BE MULTIPLE PHYSICAL LINES) S.CON1 =72 ;COLON FOR ONE ALLOWED SEPARATOR S.CON2 =134 ;BACKSLASH FOR ANOTHER ; ; DEFINE MACRO VERB AND ADDRESS DEFINITIONS .MACRO VERBDF NAME,ROUTIN,VDEF .ASCIZ /NAME/ ;NAME WITH TRAILING NULL .IF NB,VDEF VDEF=S.MAX .GLOBL VDEF .ENDC .PSECT VERBAD ;GET INTO PROPER PSECT .WORD ROUTIN ;DEFINE ADDRESS .PSECT BASIC3 ;BACK TO BASIC3 PSECT S.MAX=S.MAX+1 ;UPDATE VERB COUNTER .ENDM ; ; DEFINE MACRO FOR TOKEN DEFINITION (NO ASSOCIATED ROUTINE) ; THIS MACRO MUST BE USED ONLY AFTER ALL TOKENS WITH ASSOCIATED ADDRRESSES ; IN PSECT 'VERBAD' HAVE BEEN DEFINED. ; .MACRO TOKDEF NAME,TDEF .ASCIZ /NAME/ .IF NB,TDEF TDEF=S.MAX .GLOBL TDEF .ENDC S.MAX=S.MAX+1 .ENDM ; ; DEFINE ADDRESS OF START OF VERB PSECT .PSECT VERBAD INIT12: .PSECT BASIC3 S.BAS=140 S.MAX=S.BAS ; ; NOW DEFINE THE VERBS AND THEIR ROUTINE ADDRESSES INIT11: VERBDF LET LET00 VERBDF IFEND0 VERBDF IF IF00 S.IF VERBDF GOTO GOTO00 S.GOTO VERBDF FOR FOR00 VERBDF NEXT NEXT00 S.NEXT VERBDF GOSUB GOSB00 S.GOSB VERBDF RETURN RET00 VERBDF ! REM00 S.EXC VERBDF REM REM00 S.REM VERBDF PRINT PR00 S.PRIN VERBDF ? PR00 VERBDF INP01 VERBDF INPUT INP00 VERBDF READ READ00 VERBDF REM00 VERBDF REM00 VERBDF REM00 VERBDF TRACE TRACE0 S.TRAC VERBDF ONG00 VERBDF ON ONGT00 S.ON VERBDF CALL CALL00 VERBDF DIM DIM00 VERBDF DATA REM00 S.DATA VERBDF DEF DEF00 VERBDF RESTORE RES00 VERBDF OPLB00 VERBDF OPEN OPEN00 VERBDF CLOSE CLSE00 VERBDF LOAD LOAD00 VERBDF UNLOAD UNLD00 VERBDF CON CON00 VERBDF PRIORITY PRI00 VERBDF RANDOMIZE RND01 VERBDF STOP STOP00 VERBDF END STOP00 VERBDF STEP STEP00 S.STEP VERBDF RUN RUN00 VERBDF CLEAR CLEAR0 VERBDF DELETE DEL00 VERBDF LIST LIST00 VERBDF SAVE SAVE00 VERBDF CHAIN CHAIN0 VERBDF OVERLAY OVL00 VERBDF OLD OLD00 VERBDF SCRATCH SCRA00 VERBDF EXIT PCK11 VERBDF SLEEP SLEEP0 VERBDF BREAK BREAK0 VERBDF SET SET00 VERBDF WAIT WAIT0 S.VBEN VERBEN: FNADD: VERBDF SBS$( SBS00 S.SFST VERBDF SEG$( SEG00 VERBDF RJS$( RJS00 VERBDF LJS$( LJS00 VERBDF STR$( FCHR00 VERBDF TRM$( TRM00 VERBDF LTR$( LTR00 VERBDF DAT$( DAT00 VERBDF TIM$( TIM00 VERBDF SEC$( DUM00 VERBDF CHR$( CHR00 VERBDF MID( SBS00 VERBDF LEFT( LEFT00 VERBDF RIGHT( RIGHT0 VERBDF DDAT$( DDAT00 VERBDF PIECE$( PIECE0 VERBDF FRMT$( FORM00 VERBDF SPACE$( SPACE0 VERBDF STRING$( STRG00 VERBDF STREP$( DUM00 VERBDF R5A$( R5A00 VERBDF OCT$( OCT00 VERBDF OCS$( OCS00 S.SFEN VERBDF SIN( SINE00 S.SAST VERBDF COS( COS00 VERBDF ATN( ATN00 VERBDF EXP( EXPF00 VERBDF LOG10( LOG10 VERBDF LOG( LOG00 VERBDF ABS( ABS00 VERBDF SQR( SQRT00 VERBDF INT( INT00 VERBDF RND( RND00 VERBDF SGN( SGN00 S.SAEN VERBDF INX( INX00 S.NFST VERBDF POS( INX00 VERBDF NRC( NRC00 VERBDF LEN( LEN00 VERBDF VAL( VAL00 VERBDF ASC( ASC00 VERBDF OCT( OCB00 VERBDF COR( COR00 VERBDF DCEN( DCEN0 VERBDF TIME( DUM00 VERBDF SEC( SEC00 VERBDF ERR( ERR00 VERBDF ERL( ERL00 VERBDF AR5( AR500 VERBDF FCS( FCS00 S.NFBO ; TOKDEF FN S.FN TOKDEF THEN S.THEN TOKDEF TO S.TO TOKDEF NOT S.NOT TOKDEF AND S.AND TOKDEF XOR S.XOR TOKDEF OR S.OR TOKDEF IMP S.IMP TOKDEF EQV S.EQV TOKDEF OFF S.OFF TOKDEF ELSE S.ELSE TOKDEF PROMPT S.PRMT TOKDEF PASS-ALL-INPUT S.RPAL TOKDEF PASS-ALL-PRINT S.WPAL TOKDEF ECHO S.ECHO PROTEN: .EVEN .PSECT BASIC3 DUM00: TM2ERR ;DEFINE ERROR FOR NON-IMPLEMENTED ROUTINES .SBTTL SET - COMMAND TO SET UP MISCELLANEOUS SYSTEM CONDITIONS ;+3 ; .S ; .X R2 MOV #SET01,R0 ;START OF TOKEN LIST -> R0 1$: CMPB (R0)+,R2 ;DO WE MATCH? BEQ 2$ ;IF SO, BRANCH CMP R0,#SET02 ;AT END OF LIST? BLO 1$ ;IF NOT, KEEP LOOKING 4$: SETERR ;IF THROUGH, WE HAVE AN ERROR 2$: SUB #SET01,R0 ;GET BYTE OFFSET -> R0 DEC R0 ;ACCOUNT FOR FACT OF AUTO INC SKIP ;NEXT CODE -> R2 CMPB R2,#S.ON ;TURN CONDITION ON? BNE 3$ ;IF NOT, BRANCH MOVB #1,TRCFLG(R0) ;PUT FLAG IN APPROPRIATE BYTE BR 5$ ;AND WE ARE FINISHED 3$: CMPB R2,#S.OFF ;DO WE WANT OFF? BNE 4$ ;IF NOT, AN ERROR CLRB TRCFLG(R0) ;IF SO, RESET THE APPROPRIATE FLAG 5$: JMP INIT02 .SBTTL EXIT STATEMENT (DOCUMENTATION) ;+2 ; .S ; .X \\ ; .BR ; ^THIS STATEMENT IS USED TO RESET THE END OF FILE BRANCH ON A GIVEN ; FILE OR WITHOUT THE "_#^N", IT SETS THE TERMINAL END OF FILE BRANCH. ; ^THE SPECIFIED FILE MUST HAVE BEEN OPENED WITH THE POSSIBILITY OF ; BEING READ FROM (I.E. CANNOT BE R2 CMPB R2,#'# ;FILE SPEC'D? BNE 1$ ;IF NOT, BRANCH MOV #400,R0 ;LOOK FOR FILE WITH READ POSSIBLE JSR PC,FILFND ;FIND IT WITH PTR -> R3 BNE 4$ ;IF THERE, BRANCH FNMERR ;ELSE ERROR 4$: SKIP ;NEXT CHAR -> R2 TST (R3)+ ;AND MAKE FCB PTR CONSISTENT WITH TERMINAL BR 2$ ;AND BRANCH 1$: MOV INPT,R3 ;TERMINAL FCB ADD -> R3 2$: CMPB R2,#S.THEN ;DO WE HAVE "THEN" BEQ 3$ ;YES, BRANCH CMPB R2,#S.GOTO ;OR MAYBE "GOTO" BEQ 3$ ;OK TOO 5$: IFERR ;ELSE ERROR 3$: MOV R3,-(SP) ;SAVE FCB PTR EVAL ;EVALUATE LINE # BVS 5$ ;CLOSE PAREN AT END IS ERROR MOV (SP)+,R3 ;RESTORE FCB PTR STCFI AC0,16(R3) ;SAVE LINE # JMP INIT02 ;AND GO TO NEXT STATEMENT .SBTTL SINGLE LINE STEP INSTRUCTION ;+2 ; .SL ; .X ^^STEP\\ ; .X ^SINGLE LINE EXECUTE ; .HEADERLEVEL 1 ^^STEP [LINE _#]\\ ; .BR ; ^THIS STATEMENT ALLOWS ONE TO STEP THROUGH A PROGRAM ONE LINE AT ; A TIME. ; ^THE OPTIONAL LINE NUMBER MAY BE USED TO START AT A DIFFERENT LINE. ; ^IF NO LINE NUMBER IS SPECIFIED, EXECUTION RESUMES AT THE LINE ; FOLLOWING THE LAST STOP. ; ^NOTE THAT IF A BRANCH IS TAKEN THE LINE BEING EXECUTED, ; THE PROGRAM WILL NOT STOP UNTIL THE NEXT LINE AFTER THE BRANCH. ; ^THE STOP USES THE SAME INTERNAL FACILITIES AS THE ; _^^B BREAK FEATURE. ; .BR ; ^EXAMPLE: ; .NF ; ^^ ; {STEP} ; {STEP 510} ; \\ ; .F ;- .SBTTL PROGRAM CONTINUE ;+2 ; .SL ; .X ^^CON\\ ; .X ^PROGRAM CONTINUE ; .HEADERLEVEL 1 ^^CON [LINE _#]\\ ; .BR ; ^THIS COMMAND ALLOWS ONE TO RESUME EXECUTION OF A PROGRAM ; AFTER STOPPING IT FOR INTERACTIVE DE-BUGGING. ; ^WHEN USED WITH THE OPTIONAL LINE NUMBER, IT FUNCTIONS ; JUST LIKE ^^GOTO\\ ; WITH THE EXCEPTION THAT THE NEXT AVAILABLE LINE AFTER THE ONE SPECIFIED ; IS USED IF THERE IS NO EXACT MATCH. ; ^IF NO LINE NUMBER IS SPECIFIED, EXECUTION IS RESUMED AT THE LINE FOLLOWING ; THE LAST STOP. ; .BR ; ^EXAMPLE: ; ^^ ; .NF ; {CON} ; {CON 100} ; \\ ; .F ;- STEP00: INC BRFLAG ;SET UP FOR STOP AFTER LINE EXECUTED CON00: SKIP ;GET NEXT CHAR CMP R2,#S.EOS1 ;END OF STATEMENT? BLO 1$ ;IF NOT, BRANCH MOV LASTEX,R0 ;GET LAST EXECUTED LINE IN R0 INC R0 ;WE WANT NEXT ONE MOV #1,-(SP) ;FLAG FOR INEXACT MATCH JMP GOTO03 ;FINISH AS A GOTO 1$: DEC R1 ;BACK UP TEXT POINTER MOV #1,-(SP) ;FLAG TO TAKE NEXT AVAILABLE LINE JMP GOTO04 ;AND DO A REGULAR GOTO .SBTTL SLEEP COMMAND ;+3 ; .SL ; .X _\\ ; .BR ; ^THE R0 BR 7$ 1$: CMPB R2,#'S ;SECONDS? BNE 2$ MOV #2,R0 BR 7$ 2$: CMPB R2,#'M ;MINUTES? BNE 3$ MOV #3,R0 BR 7$ 3$: CMPB R2,#'H ;HOURS? BNE 4$ MOV #4,R0 BR 7$ 4$: CMPB R2,#S.EOS1 ;END OF STATEMENT? BHIS 6$ ;IF SO, DEFAULT 5$: SEC ;INDICATE ERROR RTS PC 6$: DEC R1 ;BACK UP TO TERMINATOR MOV #2,R0 ;SET SECONDS TYPE 7$: STCFI AC0,R3 ;INTEGERIZE MAGNITUDE CLC ;SUCCESS RTS PC SLEEP0: JSR PC,SLPWTC ;USE COMMON CODE IN SUBROUTINE BCC 1$ ;IF OK, BRANCH 2$: SLPERR 1$: BMI 2$ ;NEGATIVE MAGNITUDE IS ERROR BEQ WTSLPC ;ZERO IS NO-OP MRKT$S #1,R3,R0 ;SET MARK TIME BCS 2$ ;BRANCH ON ERROR WTSE$S #1 ;WAIT FOR A TIME BCS 2$ WTSLPC: JUNKIT ;SKIP REST OF LINE MOVB (R1)+,R2 JMP INIT03 .SBTTL WAIT0 - WAIT COMMAND - SPECIFY TIMEOUT PARAMETERS ;+3 ; .SL ; .X _\\ ; ^THE \\ ; .BR ; ^THE \\ ; .BR ; ^THIS COMMAND LOADS THE SPECIFIED FILE AS A USER CALLABLE SUBROUTINE. ; ^THE DEFAULT EXTENSION IS R3 MOV F.NRBD+2(R0),R4 ;ADDRESS OF LOAD MODULE IDENT INFO -> R4 MOV #3,R2 ;SET TO 2$: CMP (R3)+,(R4)+ ;COMPARE 3 WDS BNE 3$ ;IF NO MATCH, BRANCH SOB R2,2$ MOV (R4)+,R0 ;GET TOTAL LENGTH NEEDED MOV R4,-(SP) ;SAVE INPUT PTR TSTOK ;CHECK FOR ROOM BHIS 4$ ;IF OK, BRANCH 3$: LODERR ;ELSE ERROR 4$: MOV USR,R2 ;START OF AREA TO MOVE MOV ENUDAT,R3 ;END OF AREA TO MOVE JSR PC,SLUP ;GO SLIDE IT UP 6$: MOV USR,R2 ;OLD START OF PROGRAM -> R2 MOV #USR,R3 ;START ADDRESS OF PARAMETERS TO ;BE ADJUSTED ADD R0,(R3)+ ;NOW ADJUST ;USR ADD R0,(R3)+ ;THEM ;ENDTXT ADD R0,(R3)+ ; ;BOLNHD ADD R0,(R3)+ ; ;STUDAT ADD R0,(R3) ; ;ENUDAT MOV (R3),ENUSAV ;AND UPDATE SAVED END OF DATA TST RUNF ;ARE WE RUNNING BEQ 61$ ;IF NOT, BRANCH ADD R0,2(SP) ;IF SO, UPDATE TEXT PTR ADD R0,LINEHD ;AND LINE HEADER ADDRESS 61$: MOV (SP)+,R4 ;RESTORE INPUT PTR MOV (R4)+,R3 ;LEN OF ENTRY PT. TABLE (BYTES) -> R3 MOV R2,R1 ;COPY OLD END OF CURRENT ROUTINES ADD R3,R1 ;NEW END FOR CURRENT ROUTINES -> R1 MOV R1,-(SP) ;SAVE IT MOV R2,R0 ;CALCULATE SUB STUROU,R0 ;LEN TO MOVE (BYTES) -> R0 MOV STUROU,-(SP) ;SAVE PLACE TO INSERT EPT ADD R3,STUROU ;ADJUST PTR MOV (SP),R5 ;END OF PREVIOUS ROUTINES -> R5 TST -(R5) ;LAST ROUTINE ADDRESS -> R5 62$: CMP (R5),#TRAP00 ;IS IT A LOADED ROUTINE? BHIS 63$ ;IF NOT (IN PURE CODE), BRANCH ADD R3,(R5) ;IF SO, ADJUST ADDRESS SUB #6,R5 ;AND LOOK AT NEXT BR 62$ ;ROUTINE 63$: ASR R0 ;LEN NOW IN WORDS BEQ 8$ ;IF ZERO, CAN SKIP SOME CODE 7$: MOV -(R2),-(R1) ;MOVE UP EXISTING ROUTINES SOB R0,7$ 8$: MOV (SP)+,R2 ;PLACE TO INSERT ENTRY PTS -> R2 MOV (R4)+,R3 ;# OF ENTRY PTS -> R3 BEQ 10$ ;IF ZERO, CAN BRANCH MOV (SP),R0 ;CALCULATE OFFSET TO 9$: MOV (R4)+,(R2)+ ;MOVE IN TWO RAD50 WORDS MOV (R4)+,(R2)+ ;WITH ROUINE NAME MOV (R4)+,(R2) ;AND NOW OFFSET INTO CODE ADD R0,(R2)+ ;PLUS OFFSET TO START OF CODE SOB R3,9$ 10$: MOV (SP)+,R2 ;INSERTION PT FOR NEW ROUTINES -> R2 MOV (R4)+,R3 ;# OF WDS OF CODE TO XFER -> R3 BEQ 13$ ;IF ZERO, BRANCH MOV LNKOLD,R0 ;RESTORE FDB PTR MOV F.NRBD+2(R0),R1 ;START OF BUFFER -> R1 ADD #1000,R1 ;NOW END OF BUFFER -> R1 11$: CMP R4,R1 ;ARE WE AT END OF BUFFER BLO 12$ ;IF NOT, BRANCH GET$ ;IF SO, GET ANOTHER RECORD MOV F.NRBD+2(R0),R4 ;AND RESET PTR 12$: MOV (R4)+,(R2)+ ;MOVE IN SOB R3,11$ ;THE CODE 13$: CLOSEF ;CLOSE THE INPUT FILE MOV (SP)+,R1 ;RESTORE TEXT PTR SKIP ;CHECK FOR CMPB R2,#', ;COMMA BNE 14$ ;IF NOT, END (BRANCH) JMP LOAD00 ;IF SO, GO AROUND AGAIN 14$: DEC R1 ;OTHERWISE AT END (BACK UP TEXT PTR) BIC #FD.PLC,F.RACC(R0) ;AND CLEAR LOCATE BIT IN FDB JMP INIT02 ;AND CONTINUE ON IN PROGRAM ; .SBTTL UNLOAD - COMMAND TO UNLOAD ALL USER LOADED MACRO ROUTINES ;+7 ; .SL ; .X R3 BEQ 2$ ;IF ZERO, BRANCH ASR R3 ;NOW MAKE IT WORDS 1$: MOV (R2)+,(R4)+ ;MAKE THE MOVE SOB R3,1$ 2$: MOV R2,R3 ;COPY OLD END RTS PC .SBTTL VARIOUS POINTERS AND VARIABLES ; ; SYSTEM VARIABLES DEFINED OR STORED HERE ; USR AND ENDUSR SET UP AT BEGINNING OF PROGRAM ; .PSECT BASIC3 RDY00: .ASCII /READY/ RDY01: .BYTE 15,12,0 .EVEN .GLOBL TRAP00 VECTAB: .WORD 0 .WORD 0 .WORD 0 ;T-BIT TRAP OR BPT .WORD 0 .WORD 0 .WORD 0 .WORD TRAP00 ;TRAP INSTRUCTION .WORD 0 .END