;THIS VERSION OF FOCAL HAS 2 MAJOR PSECTS FOR ;ITS USE. PSECT CODE IS PURE CODE; PSECT DATA IS IMPURE STUFF ; ;MAIN PROGRAM FOR RSX11D FOCAL ;(ADAPTED FROM DOS INSTRUMENTATION FOCAL BY G.EVERHART) ;(ALSO BY G. EVERHART) ;FOCAL PARAMETERS AND DEFINITIONS .GLOBL INIT2,STARTX,INIT,BOTTOM,STACKO .GLOBL BOTVEC .GLOBL EVALUX .GLOBL SPSAVE,LIMTB,FTRP,XDELET,PC1 .GLOBL LINENO,CFRS,KIN .GLOBL KBILNK,KBOLNK .GLOBL KBIFIL,KBOFIL ;CONSOLE DATASETS .GLOBL TRAPH,BEGIN .GLOBL HORD,LORD,BE ;FLOATING AC TRP=104000;EMT CALLS FOR FPP HERE SORTJ=TRAP+200 SORTC=SORTJ+2 PRINTC=SORTC+2 READC=PRINTC+2 OUTCH=READC+2 ;DEFINE INTERNAL FOCAL TRAPS INCH=OUTCH+2 GETC=INCH+2 PACKC=GETC+2 TESTC=PACKC+2 GETLN=TESTC+2 FINDLN=GETLN+2 PRNTLN=FINDLN+2 COPYLN=PRNTLN+2 START=COPYLN+2 SPNOR=START+2 ERASEV=SPNOR+2 ERASET=ERASEV+2 PRINT2=ERASET+2 DIGTST=PRINT2+2 PARTST=DIGTST+2 GROOVY=PARTST+2 SKPLPR=GROOVY+2 SKPNON=SKPLPR+2 TASK=SKPNON+2 EVAL.X=TASK+2 ERROR=TRAP ;TRAP INST+0=ERROR CODE (ADD 201+(ERR #)*2) OPEN=24646 ;CMP -(SP),-(SP) CLOSE=22626 ;CMP (SP)+,(SP)+ .GLOBL THISLN PRINT=104400 ;TRAP+(0,1,177) PRINT ASCII CODE POPJ=207 ;RTS PC CR=216 ;INTERNAL CODE FOR C.R. PRCNT=45 ;ASCII FOR % SIGN TEMP=%0 AC=%1 PTR=%2 R2=%2 AXOUT=%3 CHAR=%4 ;REGS FOR OUTPUT CONVERSION P=TEMP E=PTR F=AXOUT ; ;AS USED BY FLOATING POINT BH=PTR BL=AXOUT AH=CHAR AL=R5 ONE=200 ALL=1 NALPHA=20 CRLF=5015 ;CR,LF .GLOBL STACKO .GLOBL PROC ;STARTUP AREA FOR NEW COMMANDS .GLOBL GETARG,EVAL ;ENTRY POINTS .GLOBL GETVAR,WHIPV,PWREGS ; ;DEFINITIONS OF FLOATING-POINT OPERATIONS ; FGET=TRP+0 FAD$=TRP+10 FSB$=TRP+20 FDV$=TRP+30 FML$=TRP+40 FPOW=TRP+50 FPUT=TRP+60 FNOR=TRP+70 FINT=TRP+71 FSG$=TRP+72 FAB$=TRP+73 ;ODD SPELLINGS SO AS NOT TO BE FNG$=TRP+74 ;CONFUSED WITH FLOATING-POINT INSTRUCTIONS FREAD=TRP+75 FPRINT=TRP+76 FZER=TRP+77 FCODE=TRP+200 ;100 TO 177 UNUSED ;201 TO 377 UNUSED IPTR=1 ;@PTR XPTR=2 INTO=3 FROM=3 ;FOR READABILITY THROUGH=4 IMMED=5 REL=6 STACK=0 ;FOR READABILITY DIRECT=0 .GLOBL BUFBEG ; ;END OF PARAMETERS. .NLIST TTM .TITLE FOCAL ;INSTRUMENT-TESTING VERSION OF RSX FOCAL ; .IDENT /GCE486/;G. EVERHART 2/1978, 4/1986 ; .GLOBL FPPTRP ;FPP JSR'S GO HERE ; OCTAL SUPPORT ADDED, PLUS INTEGER ARRAY DATA TYPE ; FOR USER FUNCTIONS TO USE AS IN HISTOGRAMS. ; ; GCE, 1976 ; (ENVISIONED AS NEW CAMAC TESTER) ; ;2/1978 EDITED, REMOVED BUGS GCE R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 R6=SP R7=PC ;STANDARD REGISTER DEFINITIONS ;ADAPTED FROM DEC FOCAL, WHICH LONG AGO WAS IN DECUS LIBRARY. ; ;FOR THE RSX-11D VERSION, FOCAL'S *OPERATE* COMMAND WILL SIMPLY ;USE LUNS DIFFERENT FROM THE NORMAL ONES FOR CONSOLE I/O, BUT WILL ;STILL BE FOR ASCII CODE. THE LIBRARY COMMANDS WILL CONTAIN ALL ;FILE-STRUCTURED OUTPUT. FOR INPUT, THE GET MCR COMMAND LINE ;FACILITY WILL BE USED AND IT WILL BE SET UP TO ALLOW ;3 OR 4 LEVELS OF INDIRECTION. THIS WILL REPLACE THE OLD ;LIBRARY READ COMMAND, AND LIBRARY READ WILL NOT BE IMPLEMENTED FOR ;RSX11D FOR MORE THAN 1 LEVEL (TO ALLOW PROGRAMMED READ OF PGMS) ;NOTE THAT "OPERATE" WILL ONLY HAVE AN EFFECT FOR OUTPUT DEVICES. ; ;DOCUMENTATION NOTES: ;DOUBLE QUOTE MARKS DENOTE TRAP-INSTRUCTION MODULES ;(X) MEANS THE CONTENT-OF-X. ;ASTERISKS DENOTE COMMAND MODULES. ;"C.R."MEANS "CARRIAGE RETURN". ;SINGLE QUOTE MARKS DENOTE A SUBROUTINE. ;ASSIGNMENTS OF REGISTERS ;AS USED GENERALLY TEMP=%0 ;SCRATCH AC=%1 ;ACCUMULATOR PTR=%2 ;VARIABLE POINTER R2=%2 AXOUT=%3 ;TEXT READER CHAR=%4 ;CHARACTER R5=%5 ;EXCEPTIONAL USE REGISTER AND RUBOUT PROTECTION SP=%6 ;STACK POINTER PC=%7 ;PROGRAM COUNTER PDP-11 ;AS USED BY OUTPUT CONVERSION P=TEMP ;PLACES BEFORE "." AC=AC ;TOTAL NO. OF DIGITS. E=PTR ;NO. OF INTEGER DIGITS F=AXOUT ;TOTAL NO. OF PLACES. CHAR=CHAR ;NO. OF DECIMAL POINTS R5=R5 ;SCRATCH ;AS USED BY MAIN FLOATING POINT TEMP=TEMP ;SCRATCH AC=AC ;INPUT EXP;MAY CONTAIN OP-CODES BH=PTR ;FLAC HORD;MAY CONTAIN ADDRESS BL=AXOUT ;FLAC LORD;MAY BE NEEDED BY FREAD AH=CHAR ;INPUT HORD;MAY BE NEEDED BY FREAD AL=R5 ;INPUT LORD ONE=200 ;SWITCH ASSIGNMENTS ALL=1 NALPHA=20 ;0=TERMINATE ON ASCII CODES ;1=TERMINATE ON ;;C.R.ALSO CR=216 ;INTERNAL CODE CRLF=05015 ;FOR USE IN "PRINT2, CRLF" TKS=177560 ;TELETYPE KEYBOARD TPS=177564 ;TELETYPE PRINTER LPS=177514 ;LINE PRINTER PRS=177550 ;H.S. READER PPS=177554 ;H.S. PUNCH STATUS=177776 ;MACROS FOR INTERNAL CALLS--REPLACES TRAP CALLS ;WHERE USEFUL TO DO SO. .MACRO FNDLN$ A1,A2 JSR R5,FINDX .IIF NB,A1,.WORD A1 .IIF NB,A2,.WORD A2 .ENDM .MACRO CPYLN$ A1 JSR R5,COPYLX .IIF NB,A1,.WORD A1 .ENDM .MACRO SKPLP$ A1,A2 JSR R5,XTSTLP .IIF NB,A1,.WORD A1 .IIF NB,A2,.WORD A2 .ENDM .MACRO PRTST$ A1 JSR R5,PARTSA .IIF NB,A1,.WORD A1 .ENDM .MACRO SORTJ$ A1,A2 JSR R5,SORTB .IIF NB,A1,.WORD A1 .IIF NB,A2,.WORD A2 .ENDM .MACRO SORTC$ A1,A2 JSR R5,SORTD .IIF NB,A1,.WORD A1 .IIF NB,A2,.WORD A2 .ENDM .MACRO GETLN$ A1,A2 JSR R5,GETLNX .IIF NB,A1,.WORD A1 .IIF NB,A2,.WORD A2 .ENDM .MACRO GROVY$ A1,A2 JSR R5,GROVX .IIF NB,A1,.WORD A1 .IIF NB,A2,.WORD A2 .ENDM .MACRO GETC$ JSR R5,GETX .ENDM .MACRO TESTC$ A1,A2,A3 JSR R5,TESTX .IIF NB,A1,.WORD A1 .IIF NB,A2,.WORD A2 .IIF NB,A3,.WORD A3 .ENDM .MACRO .FPP. ARG,A2 .IIF NDF,$$SMAL,JSR PC,FPPTRP .WORD ARG .IIF NB,A2,.WORD A2 .ENDM .MACRO SPNOR$ JSR R5,SPNORX .ENDM .MACRO DIGTS$ A1 JSR R5,DIGTSA .IIF NB,A1,.WORD A1 .ENDM .MACRO SKPNO$ A1,A2 JSR R5,SKPNOX .IIF NB,A1,.WORD A1 .IIF NB,A2,.WORD A2 .ENDM .MACRO EVALX$ JSR R5,EVALUX .ENDM .MACRO INCH$ A1 JSR R5,XI33 .IIF NB,A1,.WORD A1 .ENDM .MACRO OUTCH$ A1 JSR R5,XOUT .IIF NB,A1,.WORD A1 .ENDM .MACRO READC$ A1 JSR R5,CHIN .IIF NB,A1,.WORD A1 .ENDM .MACRO PRNTC$ A1,A2 JSR R5,OUT .IIF NB,A1,.WORD A1 .IIF NB,A2,.WORD A2 .ENDM .MACRO PACKC$ A1,A2 JSR R5,PACKX .IIF NB,A1,.WORD A1 .IIF NB,A2,.WORD A2 .ENDM .IF EQ,1 ;NEVER NEED THIS JUNK. REMOVE IT. ;MAIN VECTORS .CSECT ;.=;0 ;RESERVED FOR MANUAL RESTART VECTOR JMP @#INIT2 ;.=4 ;ERROR TRAP VECTOR: STACK OVERFLOW TRAP STACKO 340 ;.=10 ;RESERVED INST FTRP 100 ;.=14 ;ODT STACKO 340 ;.=20 ;IOT .GLOBL DELETE DELETE=IOT ;REMOVE A LINE OF TEXT XDELET 340 ;.=24 ;PWR-FAIL/AUTO-RESTART PWRDWN 340 ;.=30 ;TRP STACKO 340 ;.=34 ;TRAP TRAPH 340 ;.=40 ;SYSTEM VECTORS ;.=60 ; KINT STACKO ;HERE TO 'BEGIN' IS ZEROED BY 'INIT'. ;OTHER VECTORS? ;.=100 ;CLOCK OPTION ;.=200 ;LINE PRINTER ;PATCH AREA ;.=234 ;UDC VECTOR ;.=300 ;EXTRA TTY .ENDC ;"IF EQ,1" .GLOBL DELETE DELETE=IOT ; ;TO BE ADDED: ;FBUS (USER VIRTUAL ADDRESS) GIVES LOW 16 BITS OF VIRTUAL ADDR GIVEN ;FBUSH(USER VIRTUAL ADDRESS) GIVES HIGH 2 BITS OF VIRTUAL ADDR. ; ;TO BE USED FOR DMA TO NPR DEVICES. ; .EVEN .PSECT DATA,RW ;DATA AREA .EVEN .GLOBL EVTFGS EVTFGS: .WORD 0,0,0,0 ;BUFFER FOR EVENT FLAGS .WORD 0,0,0,0 ;SAFETY MARGIN SPSAVE: .WORD 0,0 ;INITIAL SP. .WORD 0,0 ; ;PATCH AREA FOR FUNCTION TABLE ;.=.+50 ;(OBSOLETE) .MCALL RDAF$S,ASTX$S ;READ ALL EVENT FLAGS,AST EXIT .EVEN .PSECT CODE,RO .EVEN BEGIN=. ;FUNCTION TABLE BACKS INTO STACK AREA. ;LIST OF FUNCTION ADDRESSES AND NAMES. 0 ;END-OF-LIST MARKER. 0 .IF DF,EPACC .IF NDF,ONEINT .WORD XFALRM,56225 ;FALRM(ALARM# 1-3,#UNITS,UNIT,GROUP) ;DOES MARKTIME AST AFTER #UNITS OF UNIT ;DELAY. INPUTS AS FOR MRKT$S SYSTEM CALL .ENDC .ENDC ;STRING FUNCTIONS .IF NDF,NOSTRG .WORD XFTRNS,60653 ;FTRNS(SUBFCT,VECTOR[SUB],LENGTH) ;IF SUBFUNCT=0,MAKE INTERNAL CODE ;IF SUBFUNCT=1, MAKE ASCII .WORD XFS2N,13706 ;FS2N(SUB1,VECTOR,LENGTH1) RETURN VALUE OF # .WORD XFN2S,13573 ;FN2S(NUMBER,VECTOR,SUBSCRIPT) MAKE STRING OF # .WORD XFSTRD,60614 ;FSTRD(SUB,VECTOR,MAXLEN)READ STRING.RTN=LEN .WORD XFSTWT,60660 ;FSTWT(SUB,VECTOR,LENGTH)PRINT PART OF STRING .WORD XFINDS,57203 ;FINDS(SUB1,VEC1,LEN1,SUB2,VEC2,LEN2) ;FIND STRING 1 IN STRING 2. RETURN POSITION. .WORD XFMOVB,57712 ;FMOVB(SUB1,VECTOR1,LEN1,SUB2,VECT2)MOVE STRING ;FROM VECT1 TO VECT2 .WORD XFCMPS,56443 ;FCMPS(SUB1,VEC1,LEN,SUB2,VEC2) COMPARE STRINGS ;RETURN 1 IF SAME. .ENDC .IF DF,FPP11 ;IF HARDWARE FLOATING POINT IS OK ; FH2S(ADDR) RETURNS FOCAL FLOATING NUMBER FROM HARDWARE FLOATING ; FORMAT NUMBER AT ADDR. ; FS2H(NUMBER, ADDR) RETURNS ADDR+4 AND PUTS FOCAL FLOATING POINT ; NUMBER INTO ADDR IN HARDWARE FLOATING POINT FORMAT. .PRINT ; ASSEMBLED USING HARDWARE FPP INSTRUCTIONS--TKB ACCORDINGLY .WORD XFS2H,13700 .WORD XFH2S,13433 .ENDC .IF DF,MTHDL ;IF MAGTAPE SPECIALS OK,... .ENDC .WORD XFDATE,13435 ;"FDAY" RETURNS (((Y*12)+M)*31)+D .IF DF,EPACC ;IF EXTERNAL PAGE ACCESS IS OK .WORD XFBUS,13507 ;FBUS (ADDR) HASHCODE+ADDR .WORD XFBUSH,56544 ;AND FBUSH(ADDR) FOR 2 HI BITS ;THESE WILL RETURN HI BITS IN BITS 4,5 AS MOST DEVICES USE THESE. .ENDC .IF NDF,XCAMFC .GLOBL XFBDGO ;MBD STARTUP ;FBDGO[CMDBLK,CHAN] TO START A CHANNEL IN MBD .GLOBL XFBDG2 ;STARTUP MBD #2 FUNCT .WORD XFBDG2,56016 ;FBDG2[CMDBLKADDR,CHAN] START MBD2 .WORD XFBDGO,56053 .GLOBL XFCNA,XFCMD,XLODM .WORD XFCNA,13451 ;FCNA[F,C,N,A] GIVES COMMAND WORD .WORD XFCMD,56342 ;FCMDB[ADDR,CODE,BUFAD,WC,FCNAD] SETS BLK UP .WORD XLODM,57515 ;FLODM[] LOADS MBD FOR USE LATER. .ENDC .IF NDF,XVRTYM .GLOBL XFOVT,XFDVT,XFOVV,XFDVV .WORD XFOVT,2762 .WORD XFDVT,2706 ;FOV AND FDV[ADDR,WC] .WORD XFOVV,14036 ;FOVV .WORD XFDVV,13556 ;FDVV[ADDR,WC] .ENDC .IF NDF,X$PLTA .GLOBL XFHSS .WORD XFHSS,1491. .ENDC .IF NDF,XLIMIT XFLIM ;FLIM(ADDR,WC,LO,HI,DEFAULT) SETS WC WORDS AT ;ADDR TO DEFAULT IF NOT BETW LO, HI 13661 XFLIMT ;FLIMT CALLED SAME, BUT LO,HI,DEFAULT ARE TABLES 57430 XFSQUZ ;FSQUZ(INADDR,WC,OUTADDR) COMPRESSES OUTPUTS 14174 ;FWRD IS NAME FOR FOCAL .ENDC .IF NDF,XVPLOT XFPLT .GLOBL XFPLT 14004 .GLOBL XFNIB,XFNIBS,XFPLB; PLTR FUNCTION ACCESS .WORD XFNIB,13706 .WORD XFNIBS,57553 .WORD XFPLB,13764;FPLD TO PROGRAMS .ENDC .IF NDF,XHIST ;HISTOGRAM FUNCTIONS XFMHST ;FMHST(DAT.ADR,DAT.WC,HST.ADR,H.WC,LO,SCL) 57540 ;HASH XFHIST ;FHIST(DAT.ADR,DAT.WC,HST.ADR,H.WC,LO,SCL) 57060 .ENDC ;XHIST .IF NDF,XMOV XFBYT ;FBYT(ADDR,# CHAR,ADDR OUT) COPIES BYTES TO WDS 13530 XFASR 13456 ;ASR (ADDR,WC) ASR'S ARRAY XFASL 13450 ;FASL(ADDR,WC ) ASL'S ARRAY XFMOV ;FMOV(ADDR IN,WC, ADDR OUT ) COPIES DATA 13742 .ENDC ;XMOV .IF NDF,XRTKB ;REAL-TIME CONSOLE SAMPLER FUNCTION XFRCHR ;FRCHR(CODE) WORKS LIKE FCHR 60042 ;BUT RETURNS -1 WHILE DATASET BUSY .ENDC XFADR ;FADR--ADDRESS OF ARRAY ELEMENT 13362 ;HASHCODE XFIOR ;FIOR--INCLUSIVE OR OF 2 ARGS 13636 XFAND ;FAND-- AND OF 2 INTEGERS 13414 XFINT ;FINT--INTERRUPT CONTROL 13634 ;HASH CODE XFEXP ;FEXP--EXPONENTIAL 13600 ;HASH CODE XFLOG ;LOG FUNCTION,FLOG 13703 XFATN ;FATN--ARC TANGENT 13456 XABS ;FAB$ -ABSOLUTE VALUE 13353 XSGN ;FSG$ -SIGN PART 14032 XFSBR ;FSBR -USER DEFINED NEW FUNCTION 14012 XCHR ;FCHR -INPUT/OUTPUT OF CHARACTER DATA 13442 XRAN ;FRAN -RANDOM NUMBER 13762 XEX ;FX -EXPERIMENTAL UNIBUS CONTROL 560 XADC ;FADC -EVALUATE ARGUMENTS FAST 13343 XSQT ;FSQT -SQUARE ROOT 14110 FSIN ;FSIN -TRIG FUNCTIONS 14042 FCOS ;FCOS -COSINE 13477 XITR ;FITR -INTEGER PART 13662 XFCLK ;FCLK -CLOCK TIME 13453 FNTABL=.+2 ;SPECIAL TOPSY-TURVEY TABLE. ;FUNCTION TABLE BACKS INTO STACK AREA. ;HASH CODE IS FORMED FROM 7-BIT ASCII WITH PLACE VALUE OF 4^N ;E.G. FX=F*4+X=106*4+130=560 ;BITS OFF LEFT ARE LOST; ZEROS COME IN FROM RIGHT. JMS=104600 ;TRAP+200 QTTB.S: SORTJ = JMS +.-QTTB.S ;SORT AND BRANCH ON (CHAR) SORTB SORTC = JMS +.-QTTB.S ;SORT CHAR SORTD PRINTC = JMS +.-QTTB.S ;PRINT CHAR-S OUT READC = JMS +.-QTTB.S ;READ DATA INTO CHAR AND PRINT IT-S CHIN OUTCH = JMS +.-QTTB.S ;OUTPUT TO A DEVICE XOUT INCH = JMS +.-QTTB.S ;INPUT FROM A DEVICE XI33 GETC = JMS +.-QTTB.S ;UNPACK A CHARACTER-S GETX PACKC = JMS +.-QTTB.S ;SAVE A CHARACTER -S PACKX TESTC = JMS +.-QTTB.S ;RETURNS ON (CHAR)= ;TERM ;NUMBER ;FUNCTION ;RETURN-ON-LETTER TESTX GETLN = JMS +.-QTTB.S ;UNPACK AND FORM A LINENUMBER GETLNX FINDLN = JMS +.-QTTB.S ;SEARCH FOR A GIVEN LINE FINDX PRNTLN = JMS +.-QTTB.S ;PRINT (LINENO) XPRNTL COPYLN = JMS +.-QTTB.S ;READ NEXT LINE NUMBER COPYLX START = JMS +.-QTTB.S ;RETURN TO COMMAND/INPUT MODE STARTX SPNOR = JMS +.-QTTB.S ;IGNORE SPACES-S SPNORX ERASEV = JMS +.-QTTB.S ;ERASE AND SET VARIABLES. ERVX ERASET = JMS +.-QTTB.S ;ERASE TEXT ERTX PRINT2 = JMS +.-QTTB.S ;PRINT TWO CHARACTERS PRIN2A DIGTST = JMS +.-QTTB.S ;TEST FOR A DIGIT OF INDICATED PLACE VALUE DIGTSA PARTST = JMS +.-QTTB.S ;CHECK FOR PARENTHESIS MATCH. PARTSA GROOVY = JMS +.-QTTB.S ;COMPARE GROUP NOS. GROVX SKPLPR = JMS +.-QTTB.S ;SKIP IF (CHAR) IS A LEFT PARENS. XTSTLP SKPNON = JMS +.-QTTB.S ;SKIP IF NOT A NUMBER SKPNOX TASK = JMS +.-QTTB.S ;DO FORMAT CONTROLS FOR *ASK*TYPE* TASKX EVAL.X = JMS +.-QTTB.S ;"PUSHJ EVAL-2" EVALUX .WORD JMS+.-QTTB.S .WORD 0 ERROR=104400 ;TRAP ;PUSHJ X=JSR PC,X OPEN=024646 ;CMP -(SP), -(SP) CLOSE=022626 ;CMP (SP)+, (SP)+ PRINT=104400 ;TRAP+(0,1,177) FOR ASCII CODES. POPJ=207 ;RTS PC COMLST=. ;*FOCAL* COMMAND DECODING LIST ;ENGLISH ;FRENCH ;SPANISH ;GERMAN ASK ;ASK ;DEMANDE ;INTERROGUE ;FRAGE .IF DF,NOBR.K ERRORC ;BEGIN ;LEVE ;XECUTE ;COMMENCE .IFF BREAK. ;BREAK OUT OF LOOPS .ENDC PC1 ;COMMENT ;COMMENTE ;COMENTARIO ;KOMMENTAR DO ;DO ;FAIZ ;HAGA ;MACHE ERASE ;ERASE ;BIFFE ;BORRE ;LOSCHE FOR ;FOR ;QUAND ;PARA ;DAFOR GOTO ;GOTO ;VA ;ADELANTE ;GEHZU .IF DF,NOSTRG ERRORC ;H- ;K- ;G- ;U- .IFF HOLENT ;STRING ENTER .ENDC IF ;IF ;SI ;SI ;WENN .IF DF,NOOJMP ;NOOJMP REMOVES "JMPON" ERRORC ;J- ;J- ;J- ;I- .IFF XJPDO ;ELSE TEST EXPR AND DO # .ENDC STOP ;KILL ;HALTE ;HALTE ;HALT LIBRARY ;LIBRARY ;ENTERPOSE ;LAZO ;BILBLIOTHEK MODIFY ;MODIFY ;MODIFIE ;MODIFIQUE ;ANDERE .IF DF,NOLRNM ;NOLRNM REMOVES LINE RENUMBERER ERRORC ;N- ;G- ;V- ;J- .IFF XLNRNM ;RENUMBER LINE (NUNBER N1,N2) FROM N1 TO N2 .ENDC PROGIO ;OPERATE ;PRATIQUE ;OBRARE ;OBERATE .IF DF,XPAKKK ERRORC ;P- ;N- ;N- ;N- .IFF PAKBUF ;PACK BUFFER FROM VECTOR OF GIVEN ADDRESS ;(MUST BE LAST CMMD ON A LINE) .ENDC STARTX ;QUIT ;ARRETE ;DETENGASE ;ENDE RET.RN ;RETURN ;RETOURNE ;RETOURNE ;QUITTE SET ;SET ;ORGANIZE ;UBIQUE ;SETZE TYPE ;TYPE ;TAPE ;TIPPEE ;RECHNE .IF NDF,XUSING USING ;USING ;U- ;W- ;P- .IFF ERRORC .ENDC VARALO ;VECTOR ;W- ;Q- ;V- WRITE ;WRITE ;INSCRIS ;ESCRIBA ;TIPPE XECUTE ;XECUTE ;XECUTE ;FLUIR ;XECUTE ERRORC ;Y ERRORC ;Z ;OTHERS UNUSED: ;YZ ;YZ ;YZ ;YZ ;TO CHANGE LANGUAGE, ALPHABETIZE ON THE APPROPRIATE COLUMN. ;LISTS TO BE TESTED BY ;"SORTJ" AND "SORTC" FLIST2: FLIMIT ;,=STANDARD *FOR* FINFIN ;;=SHORT FINERR ;CR=DUMB FLIST1: FINCR ;,=STANDARD FORMAT *FOR* TPR ;;=SET;PLUS...GO TO PROCESS TPR1 ;C.R.=SET COMMAND---GO TO PC1 ATLIST=. ;*ASK*TYPE* CONTROL CHARACTER TABLE TINTR ;%-FORMAT DELIMITER TQUOT ;"-LITERAL DELIMITER TCRLF ;!-CARRIAGE RETURN AND LINE FEED TCRLF2 ;#-CARRIAGE RETURN ONLY TDUMP ;$-DUMP THE SYMBOL TABLE CONTENTS OCTOUT ;@--TYPE OCTAL NUMBER (INTEGER ONLY) TSQUT ;'--DELIMIT STRING VECTORS TO PRINT TASK4 ;SP-TERMINATOR FOR NAMES TASK4 ;,-TERMINATOR FOR EXPRESSIONS TPR ;;-TERMINATOR FOR COMMANDS TPR1 ;C.R.-TERMINATOR FOR STRINGS ;$-FOR 'TDUMP' TERMINATES THE COMMAND! INLIST=. ;INPUT DATA CONTROL CODES. AGO ;ALTMODE=LEAVE RESULT ASPACE ;SPACE=CHECK FOR TERMINATOR FUNCTION ATAKE ;IGNORE EQUALS SIGNS ARO ;RUB OUT ATAKE ;IGNORE LINE FEEDS SRNLST=. ;*MODIFY* CONTROL CHARACTER TABLE SCHAR ;F.F.=CONTINUE SCONT ;BELL=CHANGE SEARCH CHARACTER SCONL ;L.F.=FINISH THE LINE AS BEFORE. LISTGO=. SRETN ;C.R.=END THE LINE HERE AS IS. SFOUND ;CHAR=SEARCH CHARACTER TERMS=. ;TERMINATOR TABLE FOR 'EVAL' AND 'GETVAR' .BYTE 040 ;SPACE 0 - (ASCII CODES) (INTERNAL CODES) .BYTE 053 ;+ 1 .BYTE 055 ;- 2 .BYTE 057 ;/ 3 .BYTE 052 ;* 4 .BYTE 136 ;UP ARR 5 .BYTE 050 ;( 6 L-PARS .BYTE 133 ;[ 7 .BYTE 074 ;< 10 .BYTE 051 ;) 11 R-PARS .BYTE 135 ;] 12 .BYTE 076 ;> 13 .BYTE 054 ;, 14 .BYTE 073 ;; 15 .BYTE 015 ;C.R. 16 .BYTE 075 ;= 17 TO END GETARG FROM 'SET' .BYTE 000 ALIST=. ;*ASK*TYPE* LIST OF CONTROLS (INTERNAL CODES) .BYTE 045 ;% .BYTE 042 ;" .BYTE 041 ;! .BYTE 043 ;# .BYTE 044 ;$ .BYTE 100 ;@ .BYTE '' ;' .BYTE 200 ;SPACE TLIST=. ;TERMINATORS (INTERNAL CODES) .BYTE 214 ;, .BYTE 215 ;; .BYTE 216 ;CARRIAGE RETURN .BYTE 000 ;END LIST SPECIAL=. ;FOR INPUT DATA .BYTE 33 ;ALTMODE .BYTE 200 ;SPACE .BYTE 217 ;= ECHOLST=. ;TERMINATORS (ASCII) .BYTE 134 ;BACKSLASH INSTEAD OF RUBOUT .BYTE 012 ;LINE FEED (L.F.) .BYTE 000 ;END LIST LIST6=. ;*MODIFY* .BYTE '& ;CONTROL-FORM .BYTE ': ;CONTROL-BELL .BYTE 012 ;LINE FEED ;USE & AND : INSTEAD OF FF AND BELL SO THAT ;GCML$ WILL PASS THEM. USE UNDERSCORE AS RESTART CHAR. ;CONTINUED .MCALL FSRSZ$ FSRSZ$ 7. ;ALLOW AS MANY AS 4. SIMULTANEOUS FILES! (WOW!) .EVEN .PSECT DATA,RW .EVEN LIST3=. .BYTE 216 ;RETURN ;VARIABLE STORAGE AREA:****** .BYTE -1 ;SEARCH CHARACTER-** .BYTE 000 ;END OF LIST COMBUF=. ;COMMAND/INPUT BUFFER .=.+100. CCFLG: .BYTE 0 ;CONTROL-C SEEN! .EVEN ;DEFINE RSX I/O MACROS AND CONTROL BLOCKS HERE. .MCALL QIO$,QIOW$,EXIT$S,WTSE$,WTSE$S .MCALL OPEN$M .MCALL FDOP$R,FDBK$R,FDAT$R .MCALL GCML$,FDBDF$,FDAT$A,OPEN$R,OPEN$W,CLOSE$ .MCALL GET$,PUT$,FINIT$,READ$,WRITE$,WAIT$ .MCALL GCMLB$,GCMLD$,RCML$ .MCALL CSI$,CSI$1,CSI$2 ;NOTE THAT ALL I/O TO NONFILE DEVICES WILL BE VIA WRITE/READ ;VIRTUAL BLOCK. THIS MAY HELP PROTECT AGAINST CLOBBERING DISKS. .MCALL DELET$ .IF NDF,XUSING ;****** BLOCKS FOR BINARY I/O FOR "USING" STATEMENT ; PERMIT RSX I/O FROM FOCAL!! ;DATASETS Q AND R FOR READ/WRITE I/O (VIRTUAL FILES) ;DATASETS S AND T FOR QIO$ I/O (NONFILE DEVICES ONLY) ;DATASETS 1 AND 2 FOR UNFORMATTED BINARY GET$ ;DATASETS 3 AND 4 FOR UNFORMATTED BINARY PUT$ UDSCHR: .ASCII /QRST1234/<0> .EVEN ;MATCHING CSI-BLKS FOR DATASET. USE THESE TO GET AT LINKBLK, ETC. UDSCSI: .WORD UCSIQ .WORD UCSIR .WORD UCSIS .WORD UCSIT .WORD UCSI1 .WORD UCSI2 .WORD UCSI3 .WORD UCSI4 ;CSIBLK ADDRESSES .WORD 0 ;FLAG UCSIQ: .WORD CSIUSN,ULNKQ,ULNKQ+F.ERR,URECQ ;LAST WORD IS RECORD BLK ADDR UCSIR: .WORD CSIUSN,ULNKR,ULNKR+F.ERR,URECR UCSIS: .WORD CSIUSN,ULNKS,UFILS,UTRNS ;NONFILE ONLY,.TRAN MODE UCSIT: .WORD CSIUSN,ULNKT,UFILT,UTRNT ;LAST WORD IS TRNBLK ADDR UCSI1: .WORD CSIUSN,ULNK1,ULNK1+F.ERR,UBF1 ;LAST WORD IS BUF HDR ADDR UCSI2: .WORD CSIUSN,ULNK2,ULNK2+F.ERR,UBF2 UCSI3: .WORD CSIUSN,ULNK3,ULNK3+F.ERR,UBF3 ;FILBLKS PRESET FOR .OPENI/O UCSI4: .WORD CSIUSN,ULNK4,ULNK4+F.ERR,UBF4 ; ;NOTE THESE 4 WORDS PER DATASET SHOULD BE ENOUGH TO ALLOW USE ;FOR ALL NEEDS, AND MAKE IT EASY TO GET OFFSET CSI$ CSIUSN: .BLKB C.SIZE .EVEN ;CSI BLK .WORD 5015 ;(SPARE) ERR29: ERROR+29.+29.+201 ;ERROR SOMEHOW ULNKQ: FDBDF$ ;FDB, DATASET Q (.READ/.WRITE RANDOM) FDAT$A R.VAR,,,-40.,-5;VAR. SIZE RECS, NO DEFAULT CARRIAGE CTL ;; FDRC$A FD.RAN ;RANDOM ACCESS, BUT NO BLKSIZE YET ; FDBK$A ,BUFQ,514.,,14.,UFILQ ; FDOP$A 14.,, ;SET MINIMAL INFO FOR OPEN BUFQ: .BLKB 4. ULNKR: FDBDF$ FDAT$A R.VAR,,,-40.,-5 ;AS ABOVE ; FDRC$A FD.RAN ; FDBK$A ,DBUFR,512.,,15.,UFILR ; FDOP$A 15. DBUFR: .BLKB 4. ULNKS: FDBDF$ ;FDB FOR ".TRAN"-TYPE OPS FDAT$A R.VAR,,,-5,-5 UTRNS: QIO$ IO.RLB,16.,16.,,UFILS,,<0,0,0,0,0,0> ULNKT: FDBDF$ FDAT$A R.VAR,,,-5,-5 UTRNT: QIO$ IO.RLB,17.,17.,,UFILT,,<0,0,0,0,0,0> ;USE QIO BLOCKS HERE--NOT TRAN BLOCKS. ;ALSO, THE FDB'S SHOULD MAKE SOME OTHER CONTROL BLKS ;SUPERFLUOUS. ;NOW THE GET$/PUT$ BLOCKS ULNK1: FDBDF$ ;THESE ALL USE FDB'S FDAT$A R.VAR,,,-5,-5 ; FDOP$A 18.,,,FO.RD ;LUN 18 ; FDBF$A 18. ;EVENT FLAG 18. TOO ULNK2: FDBDF$ FDAT$A R.VAR,,,-5,-5 ; FDOP$A 19.,,,FO.RD ; FDBF$A 19. ULNK3: FDBDF$ FDAT$A R.VAR,,,-5,-5 ; FDOP$A 20.,,,FO.WRT ;3 AND 4 ARE WRITE-ONLY UNITS ; FDBF$A 20. ULNK4: FDBDF$ FDAT$A R.VAR,,,-5,-5 ; FDOP$A 21.,,,FO.WRT ; FDBF$A 21. ;LUN 21. ; ;FOCAL WILL USE LUNS AS FOLLOWS: ;1--COMMAND AND CONSOLE INPUT ;2--CONSOLE OUTPUT ;3--LIBRARY OUTPUT (ONE D/S AT A TIME) ;4--FILE DELETION ;5 THROUGH 13.--OPERATE OUTPUT ON P,T,L,V,W,X,Y,Z, AND G ;14,15--USING Q,R ;16,17--USING S,T ;18,19--USING 1,2 ;20,21--USING 3,4 ;22--FRCHR INPUT ;23--FRCHR OUTPUT ;ARE FOR BINARY OPERATION HERE. (IT IS SOMEWHAT HARD TO SEE HOW ;ANY REASONABLE PROGRAM WILL ACTUALLY NEED THAT MANU FILES!) .MACRO FILB,LETT,CODE .WORD ERR29 .BYTE CODE,0 UFIL'LETT: .RAD50 /US'LETT/ .BLKW 4 .ENDM FILB Q,1 ;.OPENU FILB R,1 FILB S,0 ;ERROR TO OPEN TRAN DATASETS FILB T,0 FILB 1,4 ;.OPENI FOR 1,2 FILB 2,4 FILB 3,2 ;.OPENO FOR 3,4 FILB 4,2 UBF1: .WORD 0,7,0 ;UNFORMATTED BINARY DUMP MODE UBF1A: .WORD 0 ;ADDRESS OF DATA UBF2: .WORD 0,7,0 UBF2A: .WORD 0 UBF3: .WORD 0,7,0 UBF3A: .WORD 0 UBF4: .WORD 0,7,0 UBF4A: .WORD 0 ; ; ;RECORD BLOCKS FOR VIRTUAL DATASETS (BIDIRECTIONAL) URECQ: .WORD 2 ;2 FOR INPUT, 4 FOR OUTPUT .WORD 0 ;BUFFER ADDR .WORD 0 ;RECORD LENGTH .WORD 0,0 ;RECORD NUMBER (32 BITS) URECR: .WORD 2,0,0,0,0 ;AS ABOVE .ENDC ;XUSING ;***** LIBRARY USE BLOCKS KBISAV: .WORD 0,0 KBOSAV: .WORD 0,0 .WORD ERR21 ;FILE ERRORS CSI$ CSIBI: .BLKB C.SIZE .EVEN CSIBO: .BLKB C.SIZE .EVEN CSIBIN: ;CSIBLK FOR INPUT .WORD CSIBI .WORD CSILNK ;LINK POINTER .WORD CSIFII ;FILEBLK (STATUS RET) .WORD CMDDUM ;DATA AREA CSIBOU: .WORD CSIBO,CSILKO,CSIFIO,CMDDUM ;OUTPUT CSI BLK CSILNK: .WORD 0 ;FLAG CSILKO: .WORD 0 ;FLAG THAT CSI OUTPUT ("L O " ) ;IS IN PROGRESS GCMLD$ INCMLB:: GCMLB$ 3,FCL,,1 ;1 IS INPUT LUN ;PROMPT IS "FCL>" CMDDUM: .BLKW 7 ;DUMMY COMMAND BUFFER CBUFHD: .WORD 0,0,0 CBDAT: .BLKB 250. .WORD ERR22 ;FILEBLK ERRORS .WORD 4 ;OPENI CSIFII: .BLKW 7. ; .WORD ERR22 .WORD 2 ;.OPENO CSIFIO: .BLKW 7. ;***** END OF BLOCK OF RUBBISH FOR CSI STUFF. LSPR: 107654 ;RANDOM NUMBER LOW PART. PCF: FLTZER-2 ;PROGRAM COUNTER FOR FOCAL = (START SAVE AREA) THISLN: 0 ;LINE POINTER FROM 'FINDLN' DEBG: 1 ;(ON-OFF, ENABLE) 0,0 = TRACE. ; FOLLOWING LINE IS DUMMY VARIABLE NAME, SUBSCRIPT FOR FLARG .WORD 0,0 ;GUARD FLARG FROM LOOKING LIKE PART OF INT VRBL. FLARG: 0,0 ;RESULT STORAGE ;FLOATING ACCUMULATOR BE: 0 ;F.A. HORD: 0 ;HIGH ORDER PART LORD: 0 ;LOW ORDER PART ; LINENO: 0 ;LINE NUMBER READ BY GETLN FISW: 04012 ;OUTPUT FORMAT %8.04. SWITCH=.+1 ;"NAGSW" ETC. .IIF NDF,TTWIDV,TTWIDV=80. LINCNT: TTWIDV ;WIDTH OF TTY LINE INDEV: PRS ;POINTER TO IN. DEV STATUS OUTDEV: TPS ;POINTER TO OUT. DEV STATUS. = (END SAVE AREA) KIN: 0 ;(INTR DONE,TTY CHARACTER) WHOOPS: 000 ;POWER FAIL/AUTO-RESTART SWITCH AXIN: BUFBEG+200. ;STORAGE INDEX POINTER (STOPS 1ST "ERASEV"!) BUFR: BUFBEG ;NEXT LOCATION IN BUFFER = LAST LOCATION USED. STARTV: BUFBEG+200. ;BEGINNING OF BUFFER AREA TOP: BUFBEG ;BEGINNING OF TEXT BUFFER AREA. BOTTOM: 17500 ;END OF ALL CORE (REALLY A CONSTANT) ;CONTINUED BOTVEC: .WORD 17500 ;LOWEST ADDRESS OF VECTORS (=BOTTOM AT START AND ;AFTER AN 'ERASEV'. OUTADX: .WORD 0 ;IF NON-0, PUT PRINTED CHARACTERS HERE .EVEN .PSECT DATA,RW .EVEN CFRS: -2 ;TEXT DATA POINTER 000 ;LINE ZERO. .ASCII "C:RSX FOCAL-11 V11-01B ";VERSION ID .BYTE 216 .EVEN ;*KILL* ;STOP ALL I/O .EVEN .PSECT SYSVBL,RW SYSVBB: .$.=200 .REPT 26. .BYTE '& .BYTE <101+.$.> .WORD 0,0,0 ;VRBL $A THRU $Z .$.=.$.+1 .ENDR ;PI AND 180/PI, PRESET FOR THOSE WHO DON'T CARE TO MEMORIZE THEM. .BYTE '&,'@+200 ;VRBL "&@" IS PI... .WORD 0 ;SUBSCRIPT .WORD 175002,062207 ;3.1415926535897932... .BYTE '&,':+200 ;"&:" IS 180/PI .WORD 0 .WORD 50006,71227 ; ; ALLOW &8 AND &9 TO CONVERT TRIG FUNCTION INPUTS/OUTPUTS .BYTE '&,'8+200 .WORD 0 ;&8 = INPUT CONVERSION (MULTIPLY BY...) AMPEIG: .WORD 1,40000 ;1.0 INITIAL CONVERSION FACTOR .BYTE '&,'9+200 ;&9 = OUTPUT CONVERSION FACTOR (MULT. BY) .WORD 0 ;SUBSCRIPT NOT THERE AMPNIN: .WORD 1,40000 ;1.0 INITIAL OUTPUT CONVERSION FACTOR. .BYTE '&,'&+200 .WORD 0,0,0 ;SYSTEM VECTOR, FOR VARIOUS INTEGER CONSTANTS .BYTE '&,'% ;NAME IS &% (STD SUFFIX FOR VECTORS) .WORD 0 ;SUBSCRIPT IN USE SV.NUM=6 SV.NU1=SV.NUM-2 .WORD SV.NUM ;MAXIMUM NO. ENTRIES .WORD ASKZER ;ADDRESS OF FIRST ENTRY (0 FOR ASK) .GLOBL ASKZER ASKZER: .WORD 60 ;FIRST CHARACTER FOR ASK. ; LEGAL=200(SPACE) OR 60 (ASCII ZERO) TTWIDE: .WORD TTWIDV ;TERMINAL WIDTH ALLOWED .BLKW SV.NU1 ;OTHER VARIABLES (PRESENTLY UNDEFINED) SYSVBE: .EVEN .PSECT CODE,RO .EVEN .IF NDF,$STERR ;IF LONG ERROR MSGS ARE OK ERASCI: .ASCII /RESTART / .ASCII /ILL LINE/ ;01 .ASCII /ILL VRBL/ ;02 .ASCII /PAR MIS / ;03 .ASCII /ILL CMD / ;04 .ASCII /BD LIN #/ ;05 .ASCII /BD GRP #/ ;06 .ASCII /SET FMT / ;07 .ASCII "DBL/MS O" ;08 .ASCII /STAK OVF/ ;09 .ASCII /BIG CMD / ;10 .ASCII /VBL OVFL/ ;11 .ASCII /EXP OVFL/ ;12 .ASCII /ILL ADDR/ ;13 .ASCII /DIV BY 0/ ;14 .ASCII /EXP NEG#/;15 .ASCII /2MANYCHR/;16 .ASCII /SQRT NEG/;17 .ASCII /IN BF OV/;18 .ASCII /LIB SYN /;19 .ASCII /BD LIB F/;20 .ASCII /LB FIL E/;21 .ASCII /LN NEG #/;22 .ASCII /FAND SYN/;23 .ASCII /FINT ERR/;24 .ASCII /FADR SUB/;25 .ASCII /FRCHR #0/;26 .ASCII /HIST ADR/;27 .ASCII /USG INIT/;28 .ASCII /USG SYNT/;29 .ASCII /USG ADR /;30 .ASCII /FLIM ADR/;31 .ASCII /FWRD ADR/;32 .ASCII / /;33 .ASCII / /;34 .ASCII /ERR@FSQZ/;35 .ASCII / /;36 .ASCII / /;37 .ASCII / /;38 .ASCII / /;39 .ASCII /PACK ERR/;40 .ASCII /USG FMT /;41 .ASCII / /;42 .ASCII /RENUM BD/;43 .ASCII /NO VECSP/;44 .ASCII /STRG ERR/;45 .ASCII /N2S SMLV/;46 .ASCII /STRWRTER/;47 .ASCII /HOLL ERR/;48 .ASCII /INV ALRM/;49 .BLKB 15.*8. ;SPACE FOR 64. 8-CHAR MESSAGES .ENDC ;KILL-- HALT ALL I/O, EXIT STOP: ;RESET ;CLEAN UP FILE ACTIVITY RCML$ #INCMLB TST CSILNK ;LIB INPUT OPEN? BEQ 1$ CLOSE$ #CSIFDB 1$: TST CSILKO ;LIB OUTPUT OPEN? BEQ 2$ CLOSE$ #CSOFDB 2$: TST KBOFIL+6 ;OPERATE OUTPUT OPEN? BEQ 3$ CLOSE$ #OPFDB 3$: .IF DF,EPACC ;IF EXTERNAL PAGE IS AVAILABLE AT 28-32K .MCALL CMKT$S ;CANCEL ANY/ALL MARKTIME ALARMS CMKT$S MOV #20,R0 ;16. VECTORS 5$: TST INTPRS(R0) ;ANY INTERRUPT OPEN THIS CHNL? BEQ 4$ ;NO,BRANCH MOV INTCSR(R0),R1 ;ADDR OF CSR IN SUPER SPACE (APR7) ADD #PSWEXT,R1 ;ADJUST FOR TASK SPACE ADD #2,R1 ;SUBTRACT 177776 (=-2), ADD TASK PSW ADDR CLR INTPRS(R0) ;PREVENT INFINITE FAILURE TO EXIT MOV INTWRD(R0),@R1 ;TURN OFF INTERRUPTS. ; MOV INTWRD(R0),@INTCSR(R0) ;YES, TURN INTERRUPT OFF 4$: SUB #2,R0 BGT 5$ ;LOOP OVER ALL OF THEM .ENDC EXIT$S ;BEGONE! .PSECT DATA,RW .GLOBL LIMTB LIMTB: LIMTBL: .MCALL SVTK$ SVTK$ TPS$$,7 ; .BYTE 105.,3 ;SVTK$ ; .WORD TPS$$ ;TRAP TABLE ; .WORD 7 ;8 ENTRIES BUT THE LAST IS ILLEGAL ANYHOW. TPS$$: .WORD STACKO;ODD ADDR ERR .WORD STACKO ;SEG FAULT .WORD XDELET ;BPT .WORD XDELET ;IOT .WORD FTRP+2 ;ILL INST (FLOATING POINT INST) .WORD FTRP ;NON-RSX EMT (FPP CALL) .WORD TRAPH ;TRAP INST .WORD 0 ;11/40 FLOATING POINT INST. .WORD 0,0 .PSECT CODE,RO .IIF NDF,NFAKES,NFAKES=8 ;NUMBER OF CLOCK ALARMS PERMITTED .IF LT, NFAKES=3 .ENDC ;NFAKES MUST BE AT LEAST 3 ;STACK OVERFLOW HANDLER STACKO: MOV @#SPSAVE,SP ;RESET STACK IMMEDIATELY! ERROR+201+9.+9. ;THEN PRODUCE DIAGNOSTIC ;STACKO+2 IS PATCHED IF FUNCTION LIST IS CHANGED. ;TRAP HANDLER ;"PRINT" 0,1,177 ;TRAP 200,2,376 ;"ERROR" 201,2,377 ;USE THIS FOR PRODUCTION: TRAPH: TST (SP)+ ;FLUSH RSX EXTRA "TRAP CODE" ON STACK!!! ; MOVB 2(SP),STATUS MOV R5, 2(SP) ;SAVE R5 MOV @SP, R5 ;GET PC MOV -2(R5), @SP ;COPY CALL ;OR THE FOLLOWING FOR DEBUGGING: ;TRAPH: MOV 2(SP), -2(SP) ;KEEP THE STATUS-QUO FOR FIVE INSTRUCTIONS! ; MOV R5, 2(SP) ;SAVE R5 ONTO STACK OVER STATUS BITS. ; MOV @SP, R5 ;PICKUP THE RETURN ADDRESS. ; MOV -2(R5), @SP ;GET THE CALL ITSELF ONTO THE STACK. ; MOV -2(SP), STATUS ;RESTORE STATUS, T-BIT, ETC. ;SP= ;-CALL- ;-OLD R5- ;R5=OLD PC ASRB @SP ;EXAMINE LOW ORDER BIT OF CALL BMI NON$A$ JMP PRINTA ;GO PRINT ASCII CODES NON$A$: BCS ERR2$$ ;USE ODDS AS ERRORS ROLB @SP ;RESTORE WORD ADDRESS SUB #JMS, @SP ;COMPUTE ADDRESS OF THE POINTER. ADD #QTTB.S,@SP ;START OF TRANSFER VECTOR TABLE MOV @(SP)+, PC ;GOTO THE PROCESS. ERR2$$: JMP ERR2 ;TRANSFER VECTOR .PSECT DATA,RW .EVEN ;INTERRUPT HANDLER MUST BE NEAR ITS DATA BASE SO BOTH CAN MAP UNDER THE ;SAME APR. THUS THIS SECTION IS R/W AND PRESUMABLY MULTI-USER. ;HOWEVER, INTERRUPTS CANNOT BE HANDLED NORMALLY HERE SINCE THEY ;NORMALLY REQUIRE A TASK TO BE PRIVILEGED AND THUS TO HAVE ONLY 16K ;ADDRESS SPACE AVAILABLE TO ALLOW SCOM TO BE MAPPED IN, AND THE ;EXTERNAL PAGE. ; ;WE WILL TREAT INTERRUPTS IN A HIGHLY KLUDGED FASHION HERE WHICH ;WILL WORK ONLY ON AN 11/45 OR 11/70, VIZ: ; 1. THE INTERRUPT SERVICE ROUTINE WILL BE POSITION INDEPENDENT. ; 2. FOCAL WILL BE MAPPED INTO A COMMON IN THE EXTERNAL PAGE ; TO ALLOW IT ACCESS TO THE APR'S ; 3. THIS WILL BE USED TO MAP THE INTERRUPT SERVICE ; ROUTINE INTO SUPERVISOR SPACE WHERE PRESUMABLY ; RSX WILL NOT BOTHER IT. THE MAPPING WILL BE DONE ; VIA MTPI/MFPI AND AN INTERNAL STACK WILL BE ; ALLOCATED FOR THE SUPERVISOR SPACE. SINCE ; THE INTERRUPT SERVICE IS AT PRIO 7, RSX WILL HOPEFULLY ; NOT FIND OUT WHAT IS GOING ON AND FOCAL WILL HAVE 28K ; TO USE FOR ITS PROGRAMS AND VARIABLES. THE EXTERNAL ; PAGE COMMON MUST DEFINE THE GLOBALS "KPAR0", ; "KPDR0","SPAR6","SPDR6", AND ALL USER I-SPACE PAR AND ; PDR REGISTERS. 2 NEW FUNCTIONS, FBUS AND FBUSH WILL ; BE PROVIDED WHICH WILL FIND OUT 18-BIT ADDRESSES ; FOR FOCAL USE, BY READING THE USER APRS. SINCE THE ; INTERRUPT SERVICE ROUTINE JUST EXECUTES, SETS FLAGS AND RETURNS, ; HOPEFULLY NO FURTHER INTERACTION WILL BE NEEDED. SUPER SPACE ; MUST OF COURSE HAVE THE REAL EXTERNAL PAGE MAPPED INTO ITS ; APR7 SINCE FOCAL NEEDS TO BE ABLE TO TURN OFF INTERRUPTS. ; ; ;INTERRUPT HANDLER .IF DF,ONEINT FINTSV: MOV INTWRD,@INTCSR ;DEVICE INTERRUPT HANDLER INC INTFLG ;FLAG FOR INTERPRETER RTI ;RETURN TO NORMAL .ENDC .PSECT CODE,RO .EVEN .IF NDF,ONEINT .IF DF,EPACC GETPRI: MOV #INTPRS,R0 ;GET MAX PRIORITY PENDING INT TO R2 MOV #<20.+NFAKES-3>,R1 ;20. COUNT MAX CLR R2 ;LOWEST IS 0 5$: CMP @R0,R2 ;THIS TBL ELEMENT BIGGER? BLT 6$ ;NO, JUST UPDATE AND LOOP MOV @R0,R2 ;ELSE PUT IN NEW MAX 6$: TST (R0)+ ;BUMP R0 DEC R1 ;COUNT DOWN BNE 5$ ;AND LOOP TILL DONE RTS PC ;R2 HAS MAX PRIORITY NOW. .ENDC .ENDC .PSECT DATA,RW .EVEN .IF NDF,ONEINT ; ;INTERRUPT SERVICE FOR MULTIPLE PENDING INTERRUPTS ; FINTSV: .IF DF,EPACC MOVB @#177776,-(SP) ;SAVE INTERRUPT PRI CODED IN CC ;WHEN INTERRUPT SERVICE IS RUNNING, EXTERNAL PAGE ;IN SUPER SPACE IS MAPPED VIA APR7. BIC #-20,@SP ;LOWER 4 BITS ASL @SP ;CONVERT TO OFFSET MOV R0,-(SP) ;GET A WORK REG MOV R1,-(SP) ;REGISTER SET 0 IF 11/45 BUT BE SAFE ; MOV 2(SP),R0 ;LOAD WITH SOFT PRIO ; MOV INTWRD(R0),@INTCSR(R0) ;DISABLE FURTHER INTERRUPTS MOV 4(SP),R0 ;GET SOFT PRIO MOV R2,-(SP) MOV PC,R1 ADD #INTWRD-.,R1 ;ADDR OF INTWRD (PIC) MOV PC,R2 ADD #INTCSR-.,R2 ;ADDR OF INTCSR (PIC) ADD R0,R1 ADD R0,R2 ;POINT TO CORRECT ENTRY MOV @R2,R2 ;R2 NOW HAS CSR ADDR IN IT (IN APR7) MOV @R1,@R2 ;BASH CSR WITH MASK ADD #INTPRS-INTWRD,R1 ;GET INTPRS MASK MOV R0,@R1 MOV (SP)+,R2 MOV (SP)+,R1 ;RESTORE THE WORK REGS ; MOV R0,INTPRS(R0) ;SAVE INTERRUPT IN TBL CMP R0,IPRIPN ;TEST POSTED MAX SOFT PRIO BLT 1$ ;AND ONLY CHANGE IF A HIGHER MOV R0,IPRIPN ;PRIO IS SEEN 1$: INC INTFLG ;COUNT INTERRUPTS UP INC INTS$V ;COUNT SERVICES TO DO MOV (SP)+,R0 ;RESTORE R0 TST (SP)+ ;REMOVE COND CODES OFF STACK ; RTI ;END IT JMP @#KNLBAD ;GET KERNEL TO DO RTI SINCE WE CAN'T .ENDC ;EPACC DEFINED ;RTI TO KERNEL MODE IF NEED BE. FAKEI1: JSR R5,S.RSAV MOV #17.,R0 ;CODE 17=1ST CLOCK CHNL BR FAKCM FAKEI2: JSR R5,S.RSAV MOV #18.,R0 ;CODE 18=2ND CLOCK CHNL BR FAKCM $$$..=0 .REPT NFAKES-3 JSR R5,S.RSAV MOV #<19.+$$$..>,R0 ;ALARM CODE BR FAKCM $$$..=$$$..+1 .ENDR FAKEI3: JSR R5,S.RSAV MOV #<19.+$$$..>,R0 ; BR FAKCM ;FALL THROUGH TO FAKCM ; FAKE UP INTERRUPT ON CLOCK AST TO HERE FAKCM: MOV PC,R1 ADD #INTPRS-.,R1 ;PIC FOR ADDRESS INTPRS ASL R0 ;MAKE OFFSET ADD R0,R1 ;POINT AT OUR WORD MOV R0,@R1 ;FLAG INTERRUPT CMP R0,IPRIPN ;HIGHER PRIO PENDING? BLT 2$ ;NO MOV R0,IPRIPN ;NO,SET THIS AS PENDING 2$: INC INTFLG ;COUNT INTERRUPTS INC INTS$V ;AND SERVICES TO DO JSR R5,S.RRES ;GET BACK ALL REGS TST (SP)+ ;FLUSH EVENT FLG # FROM MRKT ASTX$S ;EXIT FROM AST .ENDC ; .IF DF,EPACC ;SUPERVISOR STACK AREA .BLKW 25. .ENDC SUPRSP: ;TOP OF SUPERVISOR MODE STACK ; .EVEN .PSECT DATA,RW .EVEN ;COMMON FLAGS ; .IF DF,ONEINT INTFLG: 0 INTWRD: 0 ;WORD TO PUT INTO CSR INTCSR: 0 ;DEVICE CSR ADDR INTLNN: 0 ;FOCAL "PC" FOR INTERRUPT IPRIFL: 0 ;FLAG WHEN NON-0 THAT INTERRUPT IS BEING SERVICED .IFF IPRIPN: 0 INTFLG: 0 INTS$C: 0 ;# SERVICES DONE INTS$V: 0 ;INTERRUPTS TO SERVICE INTWRD: .BLKW 16. INTCSR: .BLKW 16. ;BLOCKS FOR UP TO 15 INTERRUPTS INTLNN: .BLKW <20.+NFAKES-3> IPRIFL: .BLKW 1 INTPRS: .BLKW <20.+NFAKES-3> .ENDC .EVEN .PSECT CODE,RO .EVEN ; ; ;ROUTINE TO JUMP TO INTERRUPT SERVICE GROUP OR LINES ;INTERRUPT SERVICE. FOR MULTIPLE INTERRUPT SYSTEMS, ENTERED ;AT PRIORITY 7. OTHERWISE AT PRIORITY 0. S.RSAV: MOV R4,-(SP) ;EMULATE DOS REG SAVE MOV R3,-(SP) ;JSR SAVES R5 MOV R2,-(SP) MOV R1,-(SP) MOV R0,-(SP) MOV R5,-(SP) MOV 14(SP),R5 ;RESTORE R5 MOV (SP)+,PC ;RETURN S.RRES: TST (SP)+ ;SCRAP R5 FROM CALL MOV (SP)+,R0 MOV (SP)+,R1 MOV (SP)+,R2 MOV (SP)+,R3 MOV (SP)+,R4 RTS R5 ;RETURN POPS R5 BACK .GLOBL S.RSAV,S.RRES ;LET OTHER FUNCTIONS USE THESE ; INTSVC: .IF DF,EPACC ;NO-OP THIS IF EPACC UNDEF .IIF NDF,ONEINT,DEC INTS$V .IIF NDF,ONEINT,INC INTS$C JSR R5,S.RSAV .IIF NDF,ONEINT, MOV IPRIFL,-(SP) .IF NDF,ONEINT MOV OLDINT,-(SP) ;SAVE INTEGER "AC" MOV OLDMNT,-(SP) .ENDC MOV PCF,-(SP) ;SAVE REGS, FOCAL FLOATING AC MOV BE,-(SP) MOV LORD,-(SP) MOV HORD,-(SP) .IF DF,ONEINT MOV INTLNN,PCF .IFF JSR PC,GETPRI ;FIND MAX PRI MOV INTLNN(R2),PCF ;GET LINE NUMBER CLR INTPRS(R2) .ENDC MOV #PCF,R0 1$: MOV (R0)+,-(SP);SAVE FOCAL STATUS AREA CMP #KIN,R0 ;GOT IT ALL? BHI 1$ ;NO,KEEP GOING .IF DF,ONEINT MOV INTLNN,LINENO ;GET INTERRUPT LINE # .IFF MOV INTLNN(R2),LINENO ;DO SO FOR RIGHT INT IF 15 .ENDC MOV #216,R4 ;CR AT POINTER CLRB SWITCH .IF DF,ONEINT INC IPRIFL ;FLAG THAT WE ARE SERVICING AN INTERRUPT .IFF MOV IPRIPN,IPRIFL ;FLAG WHAT LEVEL INT WE SERVICE HERE CLRB @#PSWEXT ;THEN GO TO PRIO 0 .ENDC JSR PC,DO.P2 ;DO GROUP OR LINE .IF DF,ONEINT CLR IPRIFL .IFF MOVB #340,@#PSWEXT ;GO TO PRIO 7 JSR PC,GETPRI ;FIND MAX PENDING INTERRUPT LEFT MOV R2,IPRIPN ;SET IT AS PENDING NOW .ENDC MOV #KIN,R0 2$: MOV (SP)+,-(R0) ;RESTORE FOCAL STATUS CMP R0,#PCF ;DONE? BHI 2$ ;IF NOT, FINISH. .IF DF,ONEINT CLR INTFLG .IFF DEC INTFLG ;COUNT DOWN IF MULTIPLE INTS DEC INTS$C .ENDC MOV (SP)+,HORD MOV (SP)+,LORD MOV (SP)+,BE MOV (SP)+,PCF ;RESTORE AC, FCL PGM COUNTER .IF NDF,ONEINT MOV (SP)+,OLDMNT MOV (SP)+,OLDINT MOV (SP)+,IPRIFL .ENDC .IIF NDF,ONEINT, CLRB @#PSWEXT ;PRI 0 JSR R5,S.RRES .ENDC ;EPACC RTS PC ;RETURN TO MAINLINE ;ERROR DIAGNOSTIC GENERATOR ERR2: MOV #TKS, INDEV ;RESET DEVICE POINTERS MOV #PRS,INDEV ;****ADDED TO SUPPRESS NORMAF ;NORMAL FOCAL ECHO CLR OUTADX ;SET OUTPUT TO DEVICES MOV #TPS, OUTDEV ;... CLR LIBFLG ;FLAG NOT LIBRARY INPUT RCML$ #INCMLB ;RESET INPUT TO KB: TST CSILNK ;INPUT LIBRARY INPUT? BEQ KOCHKA ;NOT ACTIVE; FORGET IT CLR CSILNK ;ACTIVE. MAKE INACTIVE CLOSE$ #CSIFDB ;CLOSE THE FILE FOR HIM. IF ERR TOO BAD KOCHKA: TST KBOFIL+6 ;OPERATE OUTPUT ACTIVE? BEQ KOCHK ;NO, TEST LIB OUTPUT. CLOSE$ #OPFDB ;YES, ZAP THAT DATASET CLR KBOFIL+6 ;AND FLAG CLOSED MOV #KBOFDB,KBOLNK ;RESET CONSOLE OUTPUT. KOCHK: CMP KBOLNK,CSILKO ;OUTPUT TO F/S DEVICE? BNE ERGO2 ;NO, NORMAL HERE ON MOV KBOSAV,KBOLNK ;YES. RESTORE CLR KBOSAV ;FLAG FOR NEXT PASS MOV KBOSAV+2,KBOLNK+6 ;FLAG DEVICE TYPE TOO MOV #1,KBOB$ MOV #1,KBOB$+4 ;SET LENGTH ; CMP KBOLNK+6,#42420 ;UNLESS KB: ; BNE ERGO2 ; MOV #2,KBOB$ ; MOV #2,KBOB$+4 ;THERE SET VT AFTER EACH CHARACTER ERGO2: MOV @PC, KIN ;RESET KBD DATA/FLAG PRINT2, 37616 ;PRINTS AS "CR-LF"+"?" BIC #-100, @SP ;CLEAR THE HIGH ORDER BITS MOVB (SP)+, PTR ;SAVE CODE NUMBER .IF NDF,$STERR MOV PTR,-(SP) .ENDC JSR PC, PRNT2 ;AND PRINT IT. .IF NDF,$STERR PRINT2, " MOV R5,-(SP) MOV R0,-(SP) MOV 4(SP),R0 ASL R0 ASL R0 ;*4 ASL R0 ;*8 ADD #ERASCI,R0 MOV #8.,R5 ;LOOP COUNT 28$: MOVB (R0)+,CHAR ;GET A LETTER PRNTC$ ;PRINT LETTER DEC R5 BGT 28$ ;DO 8 LETTERS MOV (SP)+,R0 MOV (SP)+,R5 TST (SP)+ ;GET RID OF EXTRA PUSH OF CODE PRINT+ ' ;PRINT SPACE .ENDC PRINT2, " A ; "AT " PRINT+ 'T ;... MOV PCF, AC ;WHAT TYPE LINE ARE WE POINTING TO? MOV 2(AC), AC ;RETRIEVE THAT LINE NUMBER. PRNTLN ;PRINT IT OUT. PRINT2, CRLF ;GO BACK TO COMMAND/INPUT MODE. ;"START" STARTX: MOV SPSAVE,SP ;INITIALIZE THE STACK POINTER MOV #PC1+2, PCF ;INITIALIZE PC FOR FOCAL MOV #-400, DEBG ;ENABLE TRACE BUT TURN IT OFF CLR WHOOPS ;UPDATE POWER FAIL SWITCH ; CLR STATUS ;ALLOW INTERRUPTS ; BIS @PC, @#TKS ;ENABLE TELETYPE INTERRUPTS. ; CMP INDEV, #PRS ;DON'T ACKNOWLEDGE FOR H.S.R. ; BEQ .+4 ;... .IF DF,$$$AST TST LIBFLG ;LIBRARY INPUT? BNE 1$ ;YES, NO * BITB #FD.TTY,INCMLB+F.RCTL ;TTY INPUT OR INDIRECT FILE BEQ 1$ ;IF NOT TTY, NO * PRINT+ '* ;PRINT THE "READY" CODE. 1$: .ENDC MOV #COMBUF,R5 ;INIT THE COMMAND BUFFER PROTECTION MOV R5, AXIN ;FOR PACKING AND RUBOUT LIMIT. IGNOR: READC$ ;WAIT FOR KEYBOARD INPUT. CMPB CHAR, #012 ;CHECK FOR TERMINATORS BEQ IGNOR ;IGNORE LINEFEED PACKC$ ;PACK THE COMMAND STRING CMP AXIN, #COMBUF+80.-1 ;AT END? BHIS BUFFUL ;YES! CMPB CHAR, #CR ;TEST FOR C.R. BNE IGNOR ;NO, REPEAT. MOV R5, AXOUT ;SETUP FOR READING THE COMMAND/INPUT STRING GONE: GETC$ ;GET A CHARACTER SPNOR$ ;IGNORE SPACES BEFORE LINE NUMBERS. SKPNO$ ;BE SURE THAT IT IS A NUMBER INPUTN ;NOT A TERMINATOR, BEFORE STORING. JSR PC, PROC ;PROCESS IMMEDIATE COMMAND MOV PCF, AXOUT ;COMPUTE ADDRESS OF NEXT CMP AXOUT,#-2 BNE 1$ ADD #2,AXOUT BR STARTX 1$: CMP @AXOUT,#-2 BNE 2$ CLR AXOUT BR STARTX 2$: ADD (AXOUT)+,AXOUT ;LINE IN SEQUENCE. BEQ STARTX ;END FORMAT=RETURN TO C/I MODE. MOV AXOUT, PCF ;SAVE NEXT LINE ADDR. CMP (AXOUT)+,(AXOUT)+ ;PREPARE TO INTERPRET. BR GONE ;GO EXECUTE IT. ; BUFFUL: ERROR+201+10.+10. ;ROOM ONLY FOR IMMEDIATE COMMANDS. INPUTN: MOV #-1, DEBG ;DISABLE AND TURN OFF THE TRACE. GETLN$ ;READ THE DATA AS A LINE NUMBER BPL LINERR ;SINGLE LINE NUMBER? SPNOR$ ;IGNORE SPACES AFTER LINE NUMBER. JSR PC, STLIN ;PREPARE POINTER TO INSERT NEW TEXT AND BR SRETN ;SKIP TO THE TEST FOR END-OF- LINE. SRT.M2: MOVB (AXOUT)+,CHAR ;UNPACK A CHARACTER W/O TRACE. SRETN: PACKC$ ;SAVE THE BYTE ('TEMP' STILL CONTAINS (AXIN)) CMPB #CR, CHAR ;TEST FOR END OF LINE. BNE SRT.M2 ;GO BACK FOR ANOTHER. INC TEMP ;ROUND UP TO BIC #1, TEMP ;EVEN ADDRESS. MOV TEMP, AXIN ;('TEMP' IS LEFT BY "PACKC") CMP TEMP, STARTV ;ANY INTERFERENCE WITH VARIABLE AREA? BLO 1$ ERASEV ;(USES 'AC') 1$: DELETE ;REMOVE THE OLD LINE, IF ANY. (NO BREAKS!) ;AT THIS JUNCTURE ;(PTR)=>LASTLN ;(AXIN)=(BUFR)+NEW.LENGTH ;(BUFR)=>THISLN MOV PTR, AC ;COMPUTE THE NEXT ADD @AC, AC ;LINE ADDRESS AS "C-2" THEN SUB BUFR, AC ;FORM "C-NEW-2". MOV AC, @BUFR ;SAVE NEW FORWARD LINKAGE. ADD #2, AC ;"C-NEW" SUB AC, @PTR ;UPDATE OLD LINKAGE "NEW-A" MOV AXIN, BUFR ;POINT TO END OF LAST INSERTION. BR STARTX ;RETURN TO COMMAND/INPUT MODE. LINERR: ERROR+201+1.+1. ;ILLEGAL LINE NUMBER. ;"PRINT+'X" ;USE LOW BITS AS ASCII CODES. PRINTA: ROLB @SP ;RESTORE CODES. MOVB CHAR, 1(SP) ;LEAVE OLD "CHAR" IN THE STACK FOR "OUTX-2" MOVB @SP, CHAR ;(OLD, NEW) SWAB @SP ;(NEW, OLD) JMP OUTZ ;PRINT IT. ;"TESTC" ;CALLING SEQUENCE: ;TESTC ;CALL WITH (CHAR)=TEST DATA ;TADDR ;"TERMINATOR ;NADDR ;"NUMBER ;FAD$R ;"FUNCTION ; ;RETURNS IF "ALPHA TESTX: JSR R5, SPNORX ;TEST FOR SPACE AND IGNORE. BMI TEX ;MUST BE TERMINATOR TST (R5)+ ;PREPARE SECOND RETURN SKPNO$ TEX ;IF NUMBER,TAKE EXIT CMPB #056, CHAR ;OR A POINT? BEQ TEX ;YES, USE "NADDR." TST (R5)+ ;PREPARE FOR 3RD RETURN CMPB #'F, CHAR ;TEST FOR FUNCTION DESIGNATION BNE SOX ;RETURN, MUST BE "ALPHA TEX: MOV @R5, R5 ;GO BACK VIA POINTER RTS R5 ;IN ARGUMENT LIST. ;"SKPNON,YES-ADDR" ;SKIP IF NOT A NUMBER SKPNOX: CMPB CHAR, #060 ;TEST 0 BLT SOX ;TOO SMALL CMPB CHAR, #072 ;TEST 9 BR GROVZ ;NUMBER,USE YES-ADDRESS ;"SORTJ" ;CHARACTER TEST AND BRANCH ROUTINES ;SORTJ, LISTCHAR, LISTADDR, RETURN-IF-NOT-THERE SORTB: MOV (R5)+, AC ;PICKUP THE LIST POINTER AND CMPB CHAR, @AC ;TEST WITH LIST CONTENTS. BEQ SOUND ;MATCH FOUND! TSTB (AC)+ ;TEST FOR END OF LIST OR BNE SORTB+2 ;REPEAT IF NOT AT END SOX: TST (R5)+ ;RETURN IF NO MATCH FOUND (SKIP OVER EXIT) RTS R5 ;GO BACK VIA R5. ; SOUND: SUB -2(R5), AC ;COMPUTE THE INDEX FIRST THEN ASL AC ;MAKE EVEN AND ADD @R5, AC ;GET TABLE OF ADDRESSES AND FINALLY MOV @AC, R5 ;SETUP ADDRESS FOR PC. RTS R5 ;GO BACK VIA NEW R5. ;"SORTC" ;SORTC,LISTCHAR,YESADDR,RETURN-IF-NOT-THERE SORTD: MOV (R5)+, AC ;GET LIST ADDRESS CMPB @AC, CHAR ;COMPARE WITH CONTENTS BEQ TEX ;FOUND IT. TSTB (AC)+ ;TEST NEXT FOR END BNE SORTD+2 ;REPEAT BR SOX ;EXIT IF NOT THERE ;"GETLN" ;LINE NUMBER FORMATION ROUTINE GETLNX: CLRB SWITCH ;SET TO TERMINATE UPON ALPHA ;CODES (ENTRY POINT #1) CLR AC ;FOR "ALL" USE ZERO. SPNOR$ ;IGNORE LEADING SPACES BMI GALL1 ;TERMINATOR=0="ALL" CMPB #'A, CHAR ;TEST FOR "ALL BEQ GALL1 ;GO SET SWITCH AND RETURN OK SKPNO$ GTESTN ;SOUNDS LIKE A VARIABLE NAME? MOV R5, -(SP) ;SAVE RETURN JSR PC, GETARG ;READ A NAMED LINE .FPP. FGET+IPTR ;PICKUP THE VALUE. MOV (SP)+, R5 ;RESTORE RETURN GTESTW: ADD #8., BE ;MOVE 'POINT'RIGHT 8 BITS (ENTRY POINT #2) .FPP. FINT ;FIX GALL1: MOV AC, LINENO ;SAVE THE ANSWER IN "AC" AND "LINENO" BEQ GALL ;ZERO, CALL IT THE SAME AS "ALL" BMI LINERR ;PREVENT USE OF BIT 15 TSTB AC ;TEST THE STEP-NO. BEQ GGROUP ;MUST BE A GROUP. TSTB LINENO+1 ;TEST THE GROUP-NO BEQ LINERR ;MUST BE NON-ZERO BISB #ONE, SWITCH ;INDICATE A SINGLE LINE RTS R5 ;RETURN ; GALL: INCB SWITCH ;SET BIT #0 FOR "ALL". GGROUP: RTS R5 ;RETURN TO PROCESS WITH STATUS BITS SETUP. ;LINE NOS. >99.99 ARE NOT ERROR CHECKED. ; GTESTN: .FPP. FREAD ;SET TO READ A NUMBER INTERNALLY. BR GTESTW ;GO PROCESS THE RESULT ;"FINDLN" ;THIS ROUTINE LOOKS UP THE LINE WHOSE NUMBER ;MATCHES THE CONTENTS OF "LINENO" ;CALLING SEQUENCE: FINDLN, NOTADDR,RETURN-IF-FOUND ;RESULTS IF FOUND:"THISLN"=FOUND LINE OR NEXT LARGER: ;"PTR" IS THE LAST LINE, I.E.PRECEEDING OR SAME LINE. ;"AXOUT"IS SET FOR USE BY "GETC$". ;RESULTS IF-NOT-FOUND: "THISLN"=ADDRESS OF NEXT IN LINE ; "AXOUT"=NEXT OR ZERO ; "PTR"=PRIOR LINE FINDX: MOV #CFRS, AXOUT ;LOAD STARTING ADDRESS OF TEXT MOV AXOUT, PTR ;INIT FOLLOWING POINTER FINDN: MOV AXOUT, THISLN ;SAVE CURRENT POINTER CMP 2(AXOUT),LINENO ;TEST FOR MATCH BHI TEX ;PAST IT!=NOT FOUND BEQ FINDO ;RIGHT ON! MOV AXOUT, PTR ;COPY PRIOR POINTER. CMP PTR,#-2 ;THIS AN END? BEQ 2$ ;(TEST IF EQ) CMP @AXOUT,#-2 ;CHECK HERE TOO BNE 3$ CLR AXOUT BR TEX 3$: ADD (AXOUT)+,AXOUT ;GET NEW POINTER 1$: BEQ TEX ;END OF LIST=NOT FOUND BR FINDN ;TRY THE NEXT ONE. 2$: ADD #2,AXOUT BR TEX ;SIMULATE ADD FINDO: CMP (AXOUT)+,(AXOUT)+ ;MAKE IT POINT TO TEXT BR SOX ;RETURN TO SEQUENCE ;DATA STRUCTURE OF LINES: ;WORD #1 : NEXT-2 ;LAST IS 0-2 ;WORD #2 : LINE# ;GROUP. STEP ;WORDS #3-N: 7-BIT ASCII AND SPECIAL INTERNAL TEXT CODES ;LAST BYTE : 216 ;CARRIAGE RETURN ;"PRINT2,ARGARG" PRIN2A: MOVB (R5)+, CHAR ;COPY FIRST TRAILING BYTE PRNTC$ ;AND PRINT MOVB (R5)+, CHAR ;COPY SECOND TRAILING BYTE BR OUT ;AND GO PRINT IT ;"SKPLPR,NOT-ADDR" ;BRANCH IF LEFT-PARENS. NOT FOUND. XTSTLP: CMPB CHAR, #210 ;TEST FOR (<[. BHI TEX ;RIGHT TERMINATOR? - YES, USE "NOT-ADDR". CMPB CHAR, #206 ;OUT OF RANGE? GROVZ: BLO TEX ;YES, USE "NOT-ADDR" BR SOX ;OK, SKIP ONWARDS. ;"DIGTST,FIELD" DIGTSA: MOV #60, CHAR ;INITIALIZE CHARACTER CMP PTR, @R5 ;TEST FOR POSSIBILITY BLT SOX ;LEAVE IF NO MORE POSSIBLE SUB @R5, PTR ;MAKE CHANGE AND INC CHAR ;COUNT BR DIGTSA+4 ;REPEAT ;"GROOVY,NOT-ADDR" GROVX: CMPB LINENO+1,3(AXOUT) ;TEST FOR SAME GROUP BNE TEX ;GO BRANCH OR TST AXOUT ;CHECK FOR END OF TEXT BEQ TEX ;TAKE NOT-ADDR BR SOX ;JUST RETURN ;"READC" AND "PRINTC" ;I/O CONTROLS CHIN: INCH$ ;READC = INPUT CHN.P2: BIC #-200, CHAR ;CLEAR HIGH ORDER BITS BEQ CHIN ;IGNORE NULLS CMP #'_, CHAR ;UNDERBAR? BEQ INIT2 ;YES=RESTART SORTC$ ECHOLST,RUBX2 ;TEST FOR NO-ECHO SORTC$ TERMS,CHINX ;CONVERSION TEST. BR OUTW ;GO ECHO ; CHINX: ADD #200,AC ;FORM INTERNAL CODE SUB #TERMS,AC ;RELOCATIBLY MOVB AC, CHAR ;AND SAVE IT OUTW: CMP #SCONL,R5 ;DON'T BEQ RUBX2 ;ECHO SEARCH CHARACTER FROM *MODIFY*. CMPB CHAR,#CR ;INTERNAL CODE FOR CR? BNE RUBX2 ;NO MOVB TTWIDE,LINCNT ;YES,RESET PRINT POS BR RUBX2 ;NO FURTHER ECHO THOUGH ; CMP INDEV, #PRS ;DON'T ; BEQ RUBX2 ;ECHO FOR H.S.R. OUT: MOVB CHAR, -(SP) ;SAVE THIS FORM ON THE STACK. BPL OUTZ ;IF SPECIAL TERM., REGENERATE BY MOVB TERMS+200(CHAR),CHAR ;COMPUTING ASCII OUTZ: BISB #200, CHAR ;SET BIT8. .IF NDF,NOSTRG TST OUTADX ;OUTPUT TO CORE NOT DEVICE? BEQ 1$ ;NO,DEVICE... MOVB CHAR,@OUTADX ;YES,CORE. SAVE CHARACTER. BICB #200,@OUTADX ;AS 7 BIT ASCII INC OUTADX ;THEN BUMP POINTER BR OUTX ;SKIP DEVICE OUTPUT 1$: .ENDC OUTCH$ ;OUTPUT TO ANY DEVICE. CMPB #215, CHAR ;(CHANGED BY 'OUTCH') BNE OUTY ;JUST GO COUNT IT. MOVB TTWIDE,LINCNT ;INITIALIZE THE LINE COUNT. CMPB @SP, CHAR ;WAS THIS AN INTERNAL CR? BLO OUTY ;IF NOT, JUST GO COUNT. PRINT+012 ;ISSUE THAT EXTRA LINEFEED. OUTY: CMP OUTDEV, #TPS ;TEST FOR TTY OUTPUT. BNE OUTX ;IF NOT, DON'T EDITORIALIZE. DECB LINCNT ;COUNT PRINT POSITIONS BNE OUTX ;SKIP IF NOT NEAR THE MARGINS PRINT2, CRLF ;OUTPUT ONE OF EACH OUTX: MOVB (SP)+, CHAR ;RESTORE ORIGINAL DATA RTS R5 ;RETURN FROM TRAP INIT2: MOV SPSAVE,SP ;RESET STACK FOR MANUAL RESTART ; MOV #FTRP,@#10 ; MOV #TRAPH,@#34 ;RESET TRAPS ; MOV #XDELET,@#14 RCML$ #INCMLB ;RESET INPUT TO KB: FINIT$ ;RESET FILE STRUCTURE AREA CLOSE$ #CSOFDB ;REMOVE OUTPUT ON ERR CLR CSILKO ;CLR LIB OUTPUT FLAG MOV #KBOFDB,KBOLNK ;SET FDB ADDR UP CLR KBOSAV ;REMOVE ANY SPARE POINTERS ;KBOFDB SHOULD NEVER BE CLOSED WHILE FOCAL IS RUNNING! ERROR+201+0.+0. ;"PRNTLN" ;PRINT A LINE NUMBER ROUTINE XPRNTL: MOV #2005, PTR ;SET FORMAT TO %4.02 MOV AC, -(SP) ;ARGUMENT TAKEN FROM "AC" MOV #177407,-(SP) ;... .FPP. FGET+FROM+STACK ;LOAD FLAC .FPP. FPRINT ;PRINT RESULT CLOSE+STACK ;REPAIR HOLE IN THE STACK. PRINT+ ' ; ;PRINT TRAILING SPACE RTS R5 ;RETURN ;"SPNOR" ;IGNORE SPACES SPNXT: GETC$ ;MOVE ON TO NEXT CHARACTER CODE. SPNORX: CMPB #200,CHAR ;CHECK FOR SPACE SYMBOL. BEQ SPNXT ;TRY AGAIN. BR RUBX2 ;LEAVE "CHAR" IN "STATUS" AND EXIT. ;"PACKC" ;TEXT BUFFER CONTROLS PACKX: MOV AXIN, TEMP ;COPY INPUT TEXT POINTER. CMPB #134, CHAR ;TEST FOR BACKSLASH BEQ RUBIT ;GO BACK UP ONE SPACE ; CMPB #100, CHAR ;TEST FOR AT SIGN ; BEQ RUBX ;IGNORE IT CMPB #137, CHAR ;LEFT ARROW BEQ PBAR ;GO RESET. MOVB CHAR, (TEMP)+ ;SAVE CHARACTER CODE AND MOVE POINTER. CMP BOTTOM, TEMP ;TEST FOR END BHI RUBX ;CONTINUE ERROR+201+10.+10. ;C.F. INPUT! ; PBAR: MOV @SP, TEMP ;RESET INPUT POINTER. RUBIT: CMP TEMP, @SP ;TEST FOR NULL LINE(OLD R5 IS "PACKST") BEQ RUBX ;IGNORE R.O. CODE COMPLETELY DEC TEMP ;BACKUP ONE PLACE ; PRINT+ '\ ;AND ACKNOWLEDGE RECEIPT + USE. RUBX: MOV TEMP, AXIN ;SAVE POINTER RUBX2: MOVB CHAR, CHAR ;SET CONDITION CODES BEFORE LEAVING. RTS R5 ;RETURN TO MAINLINE ROUTINES. ;"GETC$" ;UNPACK A CHARACTER AND LEAVE IN 'STATUS' UTX: TSTB DEBG ;TEST FOR TRACE ENABLED BNE RUBX2 ;RETURN IF NOT ENABLED. COMB DEBG+1 ;FLIP THE TRACE FLOP GETX: MOVB (AXOUT)+,CHAR ;PICK OUT NEXT BYTE CMPB #'?, CHAR ;CHECK FOR TRACE FLIP-FLOP CODE BEQ UTX ;GO FLIP IT IF CODE FOUND PLUS ENABLED. TST DEBG ;TEST FOR BOTH DEBG+DMPS=0. BNE RUBX2 ;NOT IN TRACE NOW. BR OUT ;GO PLAY-BACK THE BYTE. ;"DELETE" ; A LINE AND ;GARBAGE COLLECTION IS DONE UP TO (STARTV); ;(BUFR) IS CORRECTED; ;(TEMP) IS AMOUNT OF CODE COLLECTED. ECOLOGY:MOV (AXOUT)+,(CHAR)+ ;STEP 3-COLLECT SPACE CMP AXOUT, STARTV ;TEST FOR COMPLETION BLOS ECOLOGY ;CONTINUE UNTIL FINISHED. SUB TEMP, BUFR ;UPDATE END OF TEXT POINTER. SUB TEMP, AXIN ;... ;*** NO INTERRRUPTS! XDELET: FNDLN$ PWRON ;SETUP LINE POINTERS FOR EXIT XD3: MOVB (AXOUT)+,CHAR ;READ THROUGH THE LINE CMPB CHAR, #CR ;CARRIAGE RETURN MARKS END BNE XD3 ;REPEAT UNTIL END REACHED. INC AXOUT ;ROUND OUT THE POINTER BIC #1, AXOUT ;TO AN EVEN NUMBER. MOV THISLN, CHAR ;COPY POINTER TO THIS LINE. ADD @CHAR, @PTR ;STEP 1-CREATE NEW RELATIVE ADD #2, @PTR ;POINTER TO NEXT LINE IN LIST. MOV AXOUT, TEMP ;COMPUTE DELTA POSITION SUB CHAR, TEMP ;AS A POSITIVE, EVEN NO. OF BYTES. MOV #CFRS, AC ;BEGIN AT TOP TO GARBAGE COLLECT. XDOX: MOV AC, PTR ;STEP 2-FOLLOW + UPDATE LINKS ("THIS") BEQ ECOLOGY ;GO COLLECT ALL ADD (AC)+, AC ;TEST FOR LAST OF KIND. CMP PTR, AXOUT ;TEST FOR ABOVE OR BELOW CHANGE AND BLO XDTHIS ;BRANCH TO FIXUP THIS ONE IF IT IS ABOVE CMP AC, AXOUT ;TEST FOR NEXT-IS-BELOW AND BHIS XDOX ;BRANCH TO NEXT ONE IF ALSO BELOW ADD TEMP, @PTR ;ADD THE CHANGE AND BR XDOX ;GO LOOK AT NEXT ITEM. ; XDTHIS: CMP AC, AXOUT ;IS NEXT ONE ABOVE THE CHANGE ALSO? BLO XDOX ;YES, CONTINUE. SUB TEMP, @PTR ; NO,CHANGE "LINE". BR XDOX ;GO TO NEXT LINE ; HERE-THERE=CHANGE HERE ; A A 0 ; B B 0 ; A B -T ; B A +T ;*IF* ;CONDITIONAL TRANSFER PROCESS ;THE FLAVORS OF *IF* ;IF (EXP)-,0,+ [3-WAY] ; -,0;...[2-WAY OR...] ; -,0 [2-WAY OR NEXT LINE] ; -;... [1-WAY OR...] ; - [1-WAY OR NEXT LINE] LOST: GETC$ BR LOSE2 IF: SPNOR$ ;GOTO LPAR (ENTRY POINT) MOV CHAR, -(SP) ;SAVE LPAR FOR "PARTST". EVALX$ ;EVALUATE THE EXPRESSION WITH PARENTHESES PRTST$ ;CHECK CLOSING PARENS AND DO 'GETC$'. TST HORD ;TEST SIGN BMI GOTO ;READY FOR - BEQ LOSE1 ;SKIP LINE NUMBER(S) LOSE2: CMPB CHAR, #214 ;TEST FOR END OF LINE NO BLO LOST ;NOT YET LOSE0: BHI PROC ;SEMI. OR C.R. (OR =!) GETC$ ;COMMA #1 LOSE1: CMPB CHAR, #214 ;LOOK FOR COMMA BNE LOSE0 ;GO TEST OTHERS GETC$ ;SKIP THE COMMA ;FALL THROUGH INTO *GOTO* ;*GO*GOTO*COMMENT*CONTINUE*RETURN*XECUTE* ;PRIMARY CONTROL AND TRANSFER GOTO: GETLN$ ;READ THE ADDRESS AND FNDLN$ SERR ;ATTACH TO NEW LINE. PSCAN: MOV THISLN, PCF ;SET NEW LINE POINTER PROCESS:GETC$ ;READ A CHARACTER IN LINE PROC: CMP SP,#64 ;TEST FOR STACK OVERFLOW HERE BHI QPROC ;IF OK, NO PROBLEM JMP STACKO ;ELSE FLAG ERROR QPROC: .IF DF,GBEVF ;IF GLOBAL EVENT FLAG #56 SHOULD RESTART RDAF$S #EVTFGS ;READ ALL EVENT FLAGS BIT #200,EVTFGS+6 ;CHECK #56. BEQ 54$ ;IF 0, GO ON .MCALL CLEF$S CLEF$S #56. ;IF RESTART, FIRST CLR E.F. 56 JMP INIT2 ;ELSE RESTART 54$: .ENDC .IF DF,EPACC ;IF INTS CAN HAPPEN ;TEST FOR PENDING INTERRUPT ; TST INTFLG BEQ NOINTP ;NONE PENDING .IF DF,ONEINT TST IPRIFL ;SEE IF AN INTERRUPT IS ALREADY BEING ;SERVICED BNE NOINTP ;AND IF SO, KEEP ON UNTIL RETURN .IFF TST INTS$V ;CHECK IF WE NEED TO CALL SERVICE MORE BLE NOINTP ;IF NOT, DON'T... MXCINT=16. ;MAX # OF NESTED INTERRUPT CONTEXTS TO ALLOW. CMP INTS$C,#MXCINT ;IF TOO MANY PUSHED NOW... BHIS NOINTP ;DON'T PUSH ANY MORE TILL THEY FINISH ;(AVOIDS STACK OVERFLOW IN STACK OF FOCAL AT PRI 7 [==CRASH RSX]) CMP IPRIPN,IPRIFL ;SEE IF WE ARE SERVICING BLE NOINTP ;THE HIGHEST PRIORITY INTERRUPT MOVB #340,@#PSWEXT ;IF NOT, SET PRI7 AND SWAP .ENDC JSR PC,INTSVC ;PENDING INTERRUPT--HANDLE IT .ENDC NOINTP: CMPB CHAR, #CR ;TEST FOR END OF LINE BNE 1$ JMP PC1 ;GO ON--PROCESS NEXT LINE 1$: MOVB CHAR, AC ;COPY DATA BMI PROCESS ;IGNORE TERMINATORS CMPB #'A, CHAR ;CHECK DATA BGT ERRORC ;TOO LOW. CMPB #'Z, CHAR ;TOO HIGH? BGE PC2 ;OK ERRORC: ERROR+201+4.+4. ;ILLEGAL COMMAND CODE. PC2: GETC$ ;IGNORE REST OF THE COMMAND'S BPL PC2 ;CHARACTERS UNTILL TERMINATOR REACHED. ASL AC ;MAKE BYTE COUNT INTO WORD COUNT. JMP @COMLST-202(AC) ;BRANCH TO THE COMMAND PROCESS. ; RET.RN: MOV #PC1+2, PCF ;RETURN FROM SUBROUTINE (?) JMP PC1 .PSECT DATA,RW .EVEN PC1: POPJ ;EXIT FROM LINE -2 ;DUMMY TERMINATOR FLTZER: 00000 ;DUMMY LINE NUMBER ZERO 00000 ;AND DUMMY VALUE OF FLOATING ZERO. .PSECT CODE,RO .EVEN ; TPR: TST (SP)+ ;DUMP RETURN FOR 'TASK' UPON SEMICOLONS. BR PROCESS ;GO END REST OF COMMAND LINE. ; TPR1: TST (SP)+ ;DUMP RETURN UPON C.R. POPJ ;GO EXIT FROM A LINE. ; XECUTE: JSR PC, EVAL ;RUN THROUGH SOME FUNCTION CALLS, JMP PROC ;THEN GO GET NEXT COMMAND. ;*MODIFY* ;SEARCH FOR CHARACTER IN TEXT MODIFY: GETLN$ ;READ COMMAND ARGUMENT FNDLN$ SERR ;LOOKUP THE INPUT DATA JSR PC, STLIN SCONT: READC$ ;READ SEARCH CHARACTER SILENTLY. SCONL: MOVB CHAR, LIST3+1 ;SAVE SEARCH CHARACTER SCHAR: MOVB (AXOUT)+,CHAR ;UNPACK AND PRINTOUT PRNTC$ ;EXTRA OUTPUT FOR C.R. SORTJ$ LIST3,LISTGO ;TEST FOR C.R. OR SEARCH CHARACTER PACKC$ ;SAVE OLD CHARACTER. BR SCHAR ;REPEAT ; SFIND: READC$ ;ABSORB AND ANALYSE SORTJ$ LIST6,SRNLST ;THE INPUT TEXT SFOUND: PACKC$ ;PACK NEW CHARACTER BR SFIND ;REPEAT ; SERR: ERROR+201+5.+5. ;NONEXISTANT LINE OR LINE ZERO ;START-UP-A-LINE SUBROUTINE STLIN: MOV BUFR, R5 ;COMPUTE START OF NEW LINE CLR (R5)+ ;ZERO LIST LINK AND MOV AC, (R5)+ ;SAVE LINE NUMBER BEQ SERR ;FLAG "M 0" ERROR IMMEDIATELY. MOV R5, AXIN ;SETUP INPUT POINTER RTS PC ;*WRITE* ;OUTPUT COMMAND TEXT WRITE: GETLN$ ;READ THE ARGUMENT MOV CHAR, -(SP) ;PERMIT FOLLOWING SEMICOLON. MOV AXOUT, -(SP) ; WRITE2: FNDLN$ WTESTG ;LOOKUP THE LINE MOV -2(AXOUT),AC ;TEST FOR LINE ZERO BEQ WRITEL ;BRANCH TO PRINT TITLE ONLY PRNTLN ;PRINT NON-ZERO LINE NOS. IN "AC" WRITEL: MOVB (AXOUT)+,CHAR ;READ W/O TRACE PRNTC$ ;PRINT ONE CHARACTER CMPB #CR, CHAR ;TEST FOR END BNE WRITEL ;REPEAT MOV THISLN, AXOUT ;COMPUTE NEXT LINE CMP #-2,AXOUT BNE 1$ ADD #2,AXOUT BR WGO 1$: CMP @AXOUT,#-2 BNE 3$ CLR AXOUT BR WGO 3$: ADD (AXOUT)+,AXOUT ;ADDRESS READY NOW. BEQ WGO ;LEAVE IF LAST LINE. WTESTG: TSTB SWITCH ;TEST FOR SINGLE LINE BMI WGO ;YES=EXIT GROVY$ WRED ;SAME GROUP AS LAST LINE? WRIG: CPYLN$ ;COPY THIS NEXT LINE NUMBER. BR WRITE2 ;GO FIND IT. ; WRED: PRNTC$ ;PRINT EXTRA CR AFTER GROUP. BITB #ALL, SWITCH ;TEST FOR "ALL"? BNE WRIG ;YES,KEEP IT UP. WGO: BR DOXIT ;RETURN ;*ERASE*ERASE ALL*ERASE TEXT*ERASE 'GROUP.LINE'* ERASE: TESTC$ ;TEST THE ARGUMENT, IF ANY. ERVC ;ERASE "VARIABLES ERL ;ERASE LINE OR GROUP OF TEXT LINERR ;ERROR, CMPB #'A, CHAR ;TEST FOR "ALL BNE ERT ;WHY NOT USE A VARIABLE NAME ? ERASET ;OUT THE TEXT ERV: ERASEV ;ERASE THE VARIABLES ALSO START ;GO TO COMMAND/INPUT MODE ; ERT: CMPB #'T, CHAR ;"ERASE TEXT" ONLY ? BNE ERL ;NO, DO LINE ERASET ;YES START ;GO BACK ; ERL: GETLN$ ;READ LINE NUMBER. TST AC ;DON'T ERASE LINE BEQ SERR ;ZERO! ERG: DELETE ;EXTRACT ONE LINE (NO BREAKS!) TSTB SWITCH ;TEST FOR SINGLE OR GROUP BMI ERV ;ONLY ONE TST AXOUT ;CHECK FOR END OF LIST TO BEQ ERV ;AVOID REALLY WILD LOOP! GROVY$ ERV ;TEST FOR SAME GROUP MEMBER CPYLN$ ;MOVE AHEAD BR ERG ;AND DO ANOTHER. ; ERVC: ERASEV ;*E* COMMAND IN TEXT IS OK. JMP PROC ;GO TO NEXT COMMAND OF PROGRAM. ;"COPYLN" ;USED BY *WRITE*, *ERASE*, AND *DO* COPYLX: MOV 2(AXOUT),LINENO ;USE NEXT LINE NUMBER RTS R5 ;RETURN TO *WRITE*ERASE*DO*. ;"ERASET" ERTX: MOV TOP, BUFR ;ERASE ALL TEXT MOV #-2,CFRS SUB #CFRS,CFRS ;INITIALIZE LINE 0 POINTER DATA ;(WAS MOV #0-CFRS-2,CFRS) RTS R5 ;*DO* ;RECURSIVE OPERATE DO: GETLN$ ;READ LINE # ARGUMENT DO.P2: MOV CHAR, -(SP) ;SAVE THE NEXT CHARACTER. MOV AXOUT, -(SP) ;CHARACTER POINTER OF CURRENT LOCATION MOV PCF, -(SP) ;SAVE ADDRESS OF LINE AND FNDLN$ DOGR ;LOOKUP THE LINE BR DOGRP1 ;FOUND! ; DOGR: TSTB SWITCH ;TEST FOR SINGLETON BMI DOER ;YES, OUGHT TO HAVE BEEN THERE. ;C(THISLN)=C(AXOUT). GROVY$ ;COMPARE GROUP NOS. DOER ;ERROR, NO SUCH GROUP DOGRP2: CPYLN$ ;COPY FIRST LINE NO. OF THE GROUP CMP (AXOUT)+,(AXOUT)+ ;POINT FORWARD DOGRP1: MOVB SWITCH, -(SP) ;SAVE FLAGS MOV THISLN, -(SP) ;SAVE ADDRESS OF LINE BEING DONE JSR PC, PSCAN ;SCAN COMMANDS IN THAT LINE MOV (SP)+, TEMP ;RESTORE LINE LAST DONE ADDRESS MOVB (SP)+, SWITCH ;RESTORE CORRECT SCOPE OF "DO" BMI DOCONT ;IF SINGLE LINE, WE ARE DONE NOW. MOV PCF, AXOUT ;KEEP POINTER TO NEXT LINE TO BE DONE. CMP AXOUT,#-2 BNE 1$ ADD #2,AXOUT BR DOCONT 1$: CMP @AXOUT,#-2 BNE 3$ CLR AXOUT BR DOCONT 3$: ADD (AXOUT)+,AXOUT ;COMPUTE NEXT ADDRESS IN GROUP. BEQ DOCONT ;LEAVE IF OUT OF TEXT ALTOGETHER MOV AXOUT, THISLN ;SAVE POINTER BITB #ALL, SWITCH ;TEST FOR "DO" OR "DO ALL" BNE DOGRP2 ;... CMPB 3(TEMP),3(AXOUT) ;COMPARE GROUP NOS. BEQ DOGRP2 ;GO DO NEXT ONE. DOCONT: MOV (SP)+, PCF ;... DOXIT: MOV (SP)+, AXOUT ;... MOV (SP)+, CHAR ;RESTORE THE LAST CHARACTER. JMP PROC ;CONTINUE THE STRING ; DOER: ERROR+201+6.+6. ;NO SUCH GROUP TO BE DONE. ;*SET*FOR* ;LOOP CONTROL STATEMENT SET=. FOR: JSR PC, GETARG ;LOCATE THE VARIABLE SPNOR$ ;IGNORE TRAILING SPACES (O'D) CMPB #217, CHAR ;TEST FOR "=" BNE FINERR ;ERROR TO LEFT OF = SIGN MOV PTR, -(SP) ;SAVE VARIABLE POINTER ON THE STACK. EVALX$ ;EVALUATE RIGHT HAND EXP. MOV @SP,R0 PRCNT=45 ;ASCII "%" SIGN CMPB -3(R0),#PRCNT ;THIS AN INTEGER ARRAY? BNE 1$ ;NO, PROCESS NORMALLY FOR FLTG FMT MOV -2(R0),R1 ;SUBSCRIPT .IF NDF,NOSTRG ;IF A STRING, DOUBLE SUBSCRIPT LIMIT. MOV @R0,-(SP) ;SAVE SUBSCRIPT BITB #200,-4(R0) ;A STRING? BEQ 34$ ;NO ASL @SP ;YES, DOUBLE LIMIT 34$: CMP R1,(SP)+ ;TEST SUBSCRIPT .IFF CMP R1,@R0 ;TOO BIG? .ENDC BHI FINERR ;YES,ERROR .IF NDF,NOSTRG TST R1 ;0 SUBSCRIPT? BEQ 10$ ;YES, RETURN ADDRESS BITB #200,-4(R0) ;STRING? ;STRING VECTORS HAVE 200 BIT SET IN 1ST CHAR OF THEIR NAMES. BEQ 10$ ;NOT STRING, NORMAL ADD #4,R0 ;SUB 1-N, NOT 0 SO POINT AT DATA BYTE ADD R1,R0 ;BYTE POINTER .FPP. FINT ;INTEGER TO AC MOVB AC,@R0 ;SAVE THE DATA BR 2$ ;SKIP VECTOR EVALUATION NOW .ENDC 10$: ASL R1 ;ENBYTE ADD #2,R0 ;PASS MAX. SUBSCRIPT ENTRY ADD R1,R0 ;POINTER NUMBER DESIRED .FPP. FINT ;NOW INTEGERIZE FLAC MOV AC,@R0 ;AND DUMP TO DESTINATION BR 2$ ;AND SKIP FLTG DUMP 1$: .FPP. FPUT+THROUGH+STACK ;UPDATE+INDEX VALEE 2$: SORTJ$ TLIST,FLIST1 ;TEST TERMINATOR FINERR: ERROR+201+7.+7. ;ILLEGAL FORMAT IN *SET* OR *FOR* COMMAND FINCR: EVALX$ ;EVALUATE EXPRESSION. SORTJ$ TLIST,FLIST2 ;TEST TERMINATOR BR FINERR ;ERROR CALL ; FINFIN: MOV #40000, -(SP) ;SET THE MOV #1, -(SP) ;INCREMENT TO UNITY BR FCONT ;GO SAVE THE LIMIT. ; FLIMIT: OPEN+STACK ;SAVE INCREMENT .FPP. FPUT+INTO+STACK ;... EVALX$ ;EVALUATE LIMIT FCONT: OPEN+STACK ;SAVE THE LIMIT. .FPP. FPUT+INTO+STACK ;... FCONT2: MOV AXOUT, -(SP) ;SAVE TEXT POINTER ID AND MOV PCF, -(SP) ;CURRENT LINE ADDR THEN JSR PC, PROCESS ;GO EXECUTE THE REST OF THE LINE ;RETURN POINT HERE IS ADDRESS SOUGHT BY "BREAK" COMMAND ON STACK BRK.R$: MOV (SP)+, PCF ;RESTORE TEXT POINTERS MOV (SP)+, AXOUT ;... MOV 10(SP), PTR ;GET VAR POINTER MOV #6, -(SP) ;CREATE INDEXED ADDRESS OF INCREMENT ADD SP, @SP ;... .FPP. FGET+IPTR ;LOAD FLAC WITH THE VARIABLE .FPP. FAD$+THROUGH+STACK ;ADD THE INCREMENT AND .FPP. FPUT+IPTR ;SAVE IT TST (SP)+ ;INDEX TO THE LIMIT .FPP. FSB$+FROM+STACK ;COMPARE RESULT WITH LIMIT TST HORD ;AND DROP INDEXED POINTER. BLE FCONT2 ;REPEAT. IF LIMIT NOT EXCEEDED ADD #12, SP ;UNLOAD THE STACK. POPJ ;EXIT THE COMMAND. .IF NDF,XPAKKK ; *PACK* EXECUTE DATA BUFFER AS COMMANDS AFTER PACKING FOR FOCAL ; ;BUFFER-PACK ROUTINE ;SYNTAX: ; ; PACK ADDR ; ;DATA STARTING AT ADDR IS PACKED AND EXECUTED. DATA MUST HAVE AN ;ASCII C.R. WITHIN 80. CHARACTERS OF ADDR OR ERROR IS FLAGGED. ; ; PAKBUF: EVALX$ ;GET ADDR .FPP. FINT ;INTEGERIZE SO WE CAN USE IT MOV AC,R5 ;CHECK FOR A CR WITHIN 80 BYTES MOV #80.,TEMP 1$: CMPB (R5)+,#15;C.R.? BEQ 2$ ;YES, GO AHEAD DEC TEMP ;NO, COUNT DOWN BGT 1$ 3$: ERROR+201+40.+40. ;BAD PACKING DATA 2$: JSR R5,S.RSAV MOV PCF,-(SP); SAVE VOLATILE STATUS AREA AS IN INTERRUPT MOV BE,-(SP) MOV LORD,-(SP) MOV HORD,-(SP) MOV #PCF,R0 4$: MOV (R0)+,-(SP) ;SAVE ALL THIS CMP #KIN,R0 ;DONE? BHI 4$ ;NOT YET. MOV #COMBUF,R5 ;PACK INTO TEXT AREA MOV R5,AXIN ;NORMALLY USED FOR TYPE-IN MOV #PC1+2,PCF MOV AC,-(SP) PAK.L1: MOVB @0(SP),CHAR INC @SP BIC #-200,CHAR ;REMOVE BIT 7 BEQ PAK.L1 ;IGNORE NULL JSR R5,CHN.P2 ;SET INTERNAL CODES. ;*****NOTE IMPLIED ADJACENCY!!!!!******** CMPB CHAR,#12 ;IGNORE LF BEQ PAK.L1 ;IN BUFFER PACKC$ ;PACK CHARACGER IN INTERNAL CODE CMPB CHAR,#CR ;INTERNAL C.R. CODE YET? BNE PAK.L1 ;NO, KEEP PACKING MOV #COMBUF,AXOUT TST (SP)+ PAK.L2: GETC$ ;GET CHARACTER SPNOR$ SKPNO$ ;ENSURE A NUMBER INPUTN ;RATHER THAN TERMINATOR BEFORE STORING JSR PC,PROC ;DO IMMEDIATE COMMANDS MOV PCF,AXOUT CMP AXOUT,#-2 ;BE SURE NO MEM. TRAP. BNE 1$ ADD #2,AXOUT BR RTN 1$: CMP @AXOUT,#-2 BNE 2$ CLR AXOUT BR RTN 2$: ADD (AXOUT)+,AXOUT ;GET NEXT LINE IN SEQUENCE BEQ RTN ;IF LAST, RTN MOV AXOUT,PCF ;SAVE NEXT LINE ADDR ELSE CMP (AXOUT)+,(AXOUT)+ BR PAK.L2 ;GO DO SOMETHING. RTN: MOV #KIN,R0 1$: MOV (SP)+,-(R0) ;RESTORE VOLATILE STUFF CMP R0,#PCF BHI 1$ ;TILL DONE MOV (SP)+,HORD MOV (SP)+,LORD MOV (SP)+,BE MOV (SP)+,PCF JSR R5,S.RRES JMP PROC ;THEN CONTINUE THE LINE .ENDC ; ;*BREAK* BREAK OUT OF LOOPS ;(MUST BE A *FOR* LOOP SOMEWHERE NESTED TO BREAK OUT OF. ;IF NONE FOUND, RESTARTS FOCAL.) .IF NDF,NOBR.K BREAK.: CMP SP,SPSAVE ;CHECK STACK TOO HIGH BLO 1$ ;IF NOT, OK JMP STARTX ;IF SO, JUST RESTART 1$: CMP (SP),#BRK.R$ ;SEE IF STACK POINTS TO *FOR* RETURN BEQ 2$ ;IF SO, POP 20(8) BYTES OFF & RTN TST (SP)+ ;ELSE POP ONE OFF AND TRY AGAIN BR BREAK. 2$: ADD #20,SP ;FLUSH STUFF FROM *FOR* RTS PC ;AND GET OUT .ENDC ;'JUMPTABLE' ; ;THIS SECTION IS USUALLY KNOWN AS 'ON'. FORMAT: ; ; J (EXPRESSION) N1,N2,N3 ; WHERE WE EFFECTIVELY DO N1,N2,OR N3 ACCORDING AS ; "EXPRESSION" IS NEGATIVE, ZERO, OR POSITIVE .IF NDF,NOOJMP ; ;DUPLICATE 'IF' LOGIC FIRST XJPDO: SPNOR$ ;SKIP TO LPAR MOV CHAR,-(SP) ;SAVE KIND OF PAREN EVALX$ ;EVALUATE EXPRESSION PRTST$ ;CHECK PAREN MATCH TST HORD ;NOW CHECK SIGN BPL 1$ ;NEGATIVE? BR JP.DO ;GO FLUSH LINE AND FAKE OUT "DO" 1$: BEQ JP.1 ;IF ZERO, PASS 1ST NUMBER JP.2: CMPB CHAR,#214 ;CHECK EOL BLO JP.9 ;NOT NOW JP.3: BHI JP.10 ;SEMI OR CR GOES TO NEXT LINE GETC$ ;GET FIRST COMMA JP.1: CMPB CHAR,#214 ;SEEK A COMMA BNE JP.3 ;IF NOT, CHECK MORE GETC$ ;BUT IF YOU'VE GOT IT, SKIP IT! BR JP.DO ;FLUSH LINE, FAKEOUT DO JP.9: GETC$ BR JP.2 JP.10: JMP PROC ;(BRANCH OUT OF RANGE) JP.12: JMP DO.P2 ;GO DO LINE JP.DO: GETLN$ ;FIND THE LINE NUMBER WE WANT AND FLUSH TILL TERMINATOR ;THEN GO TO DO ROUTINE. JP.20: CMPB CHAR,#214 ;FLUSH TILL ; OR CR BHI JP.12 ;GO ON WHEN GOT ONE GETC$ ;ELSE GET ANOTHER CHARACTER BR JP.20 ;AND KEEP TRYING .ENDC ;'NUMBER' LINE RENUMBERER ;NUMBER N1,N2 CHANGES LINE NUMBER 'N1' TO NUMBER 'N2' BY MAIN ;FORCE. MAKES IT POSSIBLE TO EXPAND FOCAL PROGRAMS (ALBEIT ;SOMEWHAT PAINFULLY) WITHOUT EXTENSIVE EDITS VIA TECO OR SUCH ;EDITORS. .IF NDF,NOLRNM ; XLNRNM: EVALX$ ;GET NUMBER 1 (OR EXPRESSION 1!) ADD #8.,BE ;MULTIPLY BY 256 TO GET GG.LL .FPP. FINT ;MAKE US AN INTEGER UP. MOV AC,-(SP) ;SAVE ON STACK BEQ NM.2 ;MUST BE A REAL EXPRESSION, NOT 0 CMPB CHAR,#215 ;SEMI OR CR? BLO NM.1 ;NO, SEEMS OK NM.2: TST (SP)+ ;YES; RESTORE STACK AND SCRAM JMP PROC NM.1: EVALX$ ;SO, OK, GET SECOND NUMBER ADD #8.,BE ;AND MAKE IT A LINE NUMBER .FPP. FINT TST AC ;ZERO IS ILLEGAL BEQ NM.2 ;ZERO IS ILLEGAL MOV AC,-(SP) JSR R5,S.RSAV ;OK, WE NEED REGS FOR THIS MOV LINENO,-(SP) ;LEAVE THIS ALONE ;FIRST CHECK THAT THE NEW LINE NUMBER DOES NOT ALREADY EXIST MOV 16(SP),LINENO ;GET THE NEW ONE IF THERE FNDLN$ NM.10 ;GO ON IF *NOT* THERE ERROR+201+43.+43. ;OTHERWISE HE FOULED UP NM.10: ;OK, THE NEW LINE NUMBER IS NOT THERE ;SO WE CAN RENUMBER, IF THE OLD LINE IS ;THERE. MOV 20(SP),LINENO ;PUT IN N1 FNDLN$ SERR ;GET LINE NUMBER OR COMPLAIN ;ON RETURN, "THISLN" IS LINE AND AXOUT POINTS TO LINE. ; SUB #2,AXOUT ;BACK AXOUT TO LINE NUMBER BIC #1,AXOUT ;ENSURE EVEN TSTB 16(SP) ;FINAL CHECK THAT BOTH BEQ NM.11 ;HALVES OF NUMBER ARE NONZERO TSTB 16(SP) ;SO NUMBER CAN EXIST BEQ NM.11 MOV 16(SP),@AXOUT NM.11: ;NOW RESTORE THINGS AND BUZZ OFF MOV (SP)+,LINENO JSR R5,S.RRES ;GET BACK REGS FOR FOCAL CMP (SP)+,(SP)+ ;POP 2 SAVED NUMBERS JMP PROC ;CONTINUE .ENDC .IF NDF,NOSTRG ;*HOLLERITH* V%,SUB,"STRING"[,LENGTH SCALAR VARIABLE] ;INITIALIZE VECTOR TO STRING. MAKES VECTOR A STRING VECTOR TOO. HOLENT: SPNOR$ JSR PC,GETVAR ;LOCATE VECTOR SPNOR$ BIS #200,-4(PTR) ;MAKE IT A STRING VECTOR CMP -2(PTR),#1 ;FORCE SUBSCRIPT TO BE => 1 BGE 1$ MOV #1,-2(PTR) 1$: MOV PTR,R5 ;SAVE ADDRESS ; CMPB CHAR,#214 ;COMMA (INTERNAL)? CMPB CHAR,#216 ;EOL? BLT 2$ 3$: ERROR+201+48.+48. ;ERROR--ILLEGAL H FORMAT 2$: GETC$ ;YES, PASS COMMA SPNOR$ CMPB CHAR,#'" ;DOUBLE QUOTE=DELIMIT STRING? BEQ 4$ ;YES,START STRING IN TSTB CHAR ;CHECK EOL BMI 3$ ;IF DELIMITER OTHERWISE, IT LOSES! ; BR 2$ ;JUST IGNORE OTHER JUNK 4$: CLR TEMP ;LENGTH COUNTER MOV @R5,AC ;MAX WORD SUBSCRIPT ASL AC ;BYTE SUBSCRIPT NOW ADD #4,R5 ;POINT AT 1ST DATA ADD -6(R5),R5 ;ADD SUBSCRIPT OF STRING FOR OUTPUT ADDR 5$: MOVB (AXOUT)+,CHAR ;READ WITHOUT TRACE INC TEMP ;COUNT LENGTH CMP TEMP,AC ;PAST END OF VECTOR? BHI 3$ ;YES, VECTOR TOO SMALL ERROR TSTB CHAR ;INTERNAL RUBBISH? BPL 7$ MOVB TERMS+200(CHAR),CHAR ;RECONSTITUTE ASCII 7$: CMPB CHAR,#'" ;TERMINAL DOUBLE QUOTE? BEQ 8$ ;YES, DONE STRING MOVB CHAR,(R5)+ ;NO, COPY CHARACTER BR 5$ 8$: MOV TEMP,-(SP) GETC$ SPNOR$ ;HUNT UP COMMA IF ANY, OR EOL CMPB CHAR,#214 ;COMMA? BEQ 9$ ;YES, SAVE LENGTH IN SCALAR 10$: JMP PROCJJ ;NO, DONE NOW 9$: GETC$ ;PASS COMMA JSR PC,GETVAR ;FIND THE VARIABLE (BETTER BE A SCALAR) CMPB -3(PTR),#PRCNT ;VECTOR? (IF SO, ERROR) BEQ 3$ ;YES, LOSE MOV (SP)+,HORD ;NO, SAVE LENGTH MOV #17,BE CLR LORD .FPP. FPUT+IPTR ;SAVE NUMBER IN SCALAR BR 10$ ;END .ENDC ;'EVAL' ;EVALUATE AN EXPRESSION ETERM: MOVB CHAR, R5 ;COPY THIS OP. CMPB CHAR, #211 ;THISOP=RPAR? BLO ETERM2 ;NO CLR R5 ;YES, SET THISOP=ZERO ETERM2: CMPB R5, @SP ;COMPARE TWO OPERATORS BHI EPAR ;LAST>THIS?-YES STACK AND CONTINUE MOVB (SP)+, TEMP ;SET LEFT HALF TO ONES OR STOP IF ZERO MOV TEMP, AC ;COPY THE OP CODE. BEQ EPURE ;END OF JOB?-YES, JUST GO LEAVE RESULTS .FPP. FGET+FROM+STACK ;NO, USE ITEM ON TOP OF STACK. CLOSE+STACK ;REMOVE THE ITEM ASLB AC ;MOVE OPERATOR CODE INTO POSITION ASLB AC ;... ASLB AC ;... BIC #-100, AC ;MAKE POSITIVE. EPURE: CMPB -3(PTR),#PRCNT ;CHECK VAR NAME FOR % BNE FCDD ;IF NOT, IT'S A FLOATING-PT VAR MOV -2(PTR),-(SP) BEQ 1$ ;IF 0, SAME FOR ANY VECTOR .IF NDF,NOSTRG BITB #200,-4(PTR) ;STRING VECTOR? BEQ 2$ ;NO, INTEGER VECTOR--ADDRESS THAT WAY ADD #4,@SP ;PASS ELEMENT 0 (ADDRESS USUALLY) ADD PTR,@SP ;ADDRESS OF BYTE WE WANT CLR OLDMNT ;ZERO HIGH BYTE MOVB @(SP)+,OLDMNT ;COPY BYTE BR 3$ ;GO FAKE IT !!! .ENDC 2$: ASL @SP ;ENBYTE SUBSCRIPT 1$: ADD #2,@SP ADD PTR,@SP MOV @(SP)+,OLDMNT 3$: MOV #17,OLDINT ;SETUP A NUMBER HERE MOV #OLDINT,PTR ;SETUP PTR POINTING TO IT BR FCDD .EVEN .PSECT DATA,RW .EVEN OLDINT: .WORD 0 OLDMNT: .WORD 0 ;INTEGER AREA .EVEN .PSECT CODE,RO .EVEN FCDD: ADD #FGET+IPTR,AC ;COMPUTE CODE .FPP. FCODE ;EXECUTE THE AC MOV #FLARG, PTR ;LOAD POINTER .FPP. FPUT+IPTR ;SAVE COPY OF RESULT ADD R5, TEMP ;CHECK THISOP-LASTOP BNE ETERM2 ;GO COMPARE PRIORITIES. POPJ ;EXIT ; EPAR: CMPB R5, #206 ;CHECK FOR BGE EPAR2 ;LEFT PAREN.?-YES, CMPB -3(PTR),#PRCNT ;INTEGER DATA TYPE? BNE 2$ MOV -2(PTR),-(SP) ;YES. SAVE SUBSCRIPT .IF NDF,NOSTRG BITB #200,-4(PTR) ;STRING TYPE? BEQ 1$ ;NO, INTEGER TST @SP ;0 SUBSCRIPT? BEQ 1$ ;THEN RETURN INTEGER ADDR ADD #4,@SP ;POINT AT DATA ADD PTR,@SP ;DATA BYTE ADDR MOV #17,-(SP) ;SAVE CELL ON STACK MOVB @2(SP),2(SP) ;STACK THE BYTE CLRB 3(SP) ADD #2,PTR ;LEAVE PTR EVEN! BR 3$ .ENDC 1$: ASL @SP ;ENBYTE ADD #2,@SP ;PASS MAX. SUBSCRIPT ENTRY ADD PTR,@SP ;DATA WORD ADDR! ADD #2,PTR ;MOVE NORMALLY CLR -(SP) ;PUSH EQUIVALENT FLOATING # MOV @2(SP),2(SP) MOV #17,(SP) ;EXPONENT STUFF BR 3$ 2$: MOV 2(PTR), -(SP) ;OPEN STACK AND SAVE DATA. MOV (PTR)+, -(SP) ;... 3$: MOV R5, -(SP) ;UPDATE LASTOP ARGNXT: JSR R5, SPNXT ;OUGHT TO BE AN ARGUMENT HERE BPL EVL.P2 ;TEST FOR THE TYPE ELPAR: SKPLP$ OPERR ;ILLEGAL TO STAR AN EXPRESSION ;WITH RIGHT PARENS. EPAR2: MOV CHAR, -(SP) ;SAVE THE LP CODE AND COMPUTE THE MOV #EFUN3, -(SP) ;LOAD TRANSFER FOR "POPJ" AT "EXIT" EVL.M2: GETC$ ;MOVE ONTO NEXT CHARACTER (ENTRY POINT #2) EVAL: CLR -(SP) ;SET LASTOP=0 (ENTRY POINT #1) EVL.P2: TESTC$ ;TEST CHARACTER TYPE: ETERM1 ;COULD BE A UNARY OPERATOR ENUM ;OR A NUMBER, EFUN ;OR A FUNCTION, CMPB CHAR,#100 ;@? IF SO IT'S A NUMBER BNE EVARB ;OTHERWISE A VARIABLE .FPP. FZER JSR PC,OCTIO ;CONVERT OCTAL TO DECIMAL BR ENUM2 EVARB: JSR PC, GETVAR ;OR A VARIABLE OPNEXT: SPNOR$ ;IGNORE SPACES AROUND OPERATORS (O'D) BMI ETERMN ;IF NEGATIVE, THEN IT IS A LEGIT. TERM. BR OPERR ;OTHERWISE IT IS ILLEGAL FORMAT. ; ETERM1: MOV #FLTZER,PTR ;ASSUME PRESENT VALUE OF ZERO. CMPB CHAR, #202 ;MINUS? BNE 1$ JMP ETERM ;YES, GO PROCESS IT 1$: BLO ARGNXT ;PLUS?-YES, IGNORE IT CMPB CHAR, #211 ;SOME TYPE OF RIGHT TERMINATOR? BLO ELPAR ;NO, GO TEST FOR LEFT PARENTHESIS SPECIAL CASE ETERMN: SKPLP$ ETERM ;LEFT PAREN? - NO, CONTINUE TO PROCESS OPERR: ERROR+201+8.+8. ;MISSING OR DOUBLE OPERATOR ERROR ; ENUM: MOVB #NALPHA,SWITCH ;USE INTERNAL DATA AND ACCEPT ALPHA DATA .FPP. FREAD ;READ IN A NUMBER. ENUM2: MOV #FLARG, PTR ;SET POINTER .FPP. FPUT+IPTR ;SAVE RESULT BR OPNEXT ;GO GET OPERATOR ; EFUN: CLR R5 ;OLD "EFOP" EFN.P2: ASL R5 ;HASH CODE ROL R5 ;... ADD CHAR, R5 ;... GETC$ ;READ THE MNEMONIC LETTERS BPL EFN.P2 ;REPEAT UNLESS TERMINATOR FOUND MOV CHAR, -(SP) ;SAVE LAST CHARACTER:PAREN. MOV R5, -(SP) ;SAVE HASH CODE EVALX$ ;PROCESS FIRST ARGUMENT MOV (SP)+, R5 ;GET BACK "EFOP" MOV #FNTABL,AC ;INIT THE SEARCH. 1$: TST -(AC) ;TEST FOR END. BEQ VERR ;NO SUCH FUNCTION CMP -(AC), R5 ;TEST FOR MATCH BNE 1$ ;REPEAT IF NOT FOUND. JSR PC, @-(AC) ;CALL THE FUNCTION. EFUN3: PRTST$ ;CHECK CLOSING PARENS .FPP. FNOR ;BE SURE THAT RESULTS ARE NORMALIZED. BR ENUM2 ;GO SAVE RESULTS AND SET POINTER. EVALUX: MOV R5, @SP ;SIMULATE "PUSHJ EVAL-2" BR EVL.M2 ;'GETVAR' ;FIND OR CREATE A VARIABLE VERR: ERROR+201+2.+2. ;ILLEGAL VARIABLE OR FUNCTION NAME. PERR: ERROR+201+3.+3. ;PAREN MISMATCH ERROR GETARG: TESTC$ ;CHECK CAREFULLY FINERR ;TERMINATOR IS NOT A VARIABLE. VERR ;N VERR ;F=? PTR=HOLE GETVAR: MOV #100000,-(SP) ;CLEAR NAME SPACE ON STACK TO "SPACE". MOVB CHAR, @SP ;SAVE FIRST LETTER OF NAME IN STACK CLR -(SP) ;CLEAR SUBSCRIPT SPACE ON STACK GETC$ ;READ AND TRACE NEXT CHARACTER BMI GSERCH ;TEST FOR TERMINATOR BISB CHAR, 3(SP) ;SAVE SECOND LETTER OF NAME CMPB CHAR,#PRCNT ;IF A % SIGN,... BNE 1$ ;THEN MUSTN'T HAVE H.O. BIT ON BIC #100000,2(SP) ;IN VRBL NAME 1$: GETC$ ;IGNORE UNTILL TERMINATOR FOUND. BPL 1$ ;--- GSERCH: SKPLP$ GS1 ;CHECK FOR SUBSCRIPT MOV CHAR, -(SP) ;SAVE LEFT PARENS. CODE. EVALX$ ;EVALUATE THE SUBSCRIPT AND .FPP. FINT ;CORRECT IT TO AN INTEGER MOV AC, 2(SP) ;SAVE SUBSCRIPT ON STACK .IF DF,EXSYM ;IF BASIC-TYPE SYMBOLS WANTED, CMPB 5(SP),#PRCNT ;AND NOT INTEGER-TYPE ARRAY BEQ 2$ BISB #200,4(SP) ;SET HIGH BIT OF NAME TO FLAG SUB 2$: .ENDC CMPB CHAR, #214 ;COMMA? BNE GS0 ;SKIP IF ONLY ONE SUBSCRIPT. EVALX$ ;GO READ THE SECOND SUBSCRIPT. .FPP. FINT ;CONVERT IT TO 0-256. MOVB AC, 3(SP) ;COPY 2AND INTO LEFT HALF. .IF DF,EXSYM ;IF BASIC-TYPE SYMBOL TABLE CMPB 5(SP),#PRCNT BEQ 3$ BICB #200,5(SP) ;CLEAR SIGN BIT OF BYTE 3$: .ENDC GS0: PRTST$ ;CHECK FOR CLOSING PARENS MATCH. BR GS1 ;WHIP UP A VARIABLE &(C(TEMP)) WHIPV: MOV #100046,-(SP) MOV TEMP, -(SP) ;STACK NOW CONTAINS: ;*SUBS* (SP) ;*NAME* 2(SP) GS1: CMPB 2(SP),#'& ;COULD IT BE SYS VRBL? BNE 1$ ;NO WAY--DO REGULAR SEEK MOV #SYSVBB,PTR ;YES, LOOK IN THOSE FIRST MOV #SYSVBE,R5 JSR R5,GTRY ;TRY TO FIND + USE VRBL 1$: .IF DF,GBCMN ;IF GLOBAL COMMON MAY HAVE VARIABLES .GLOBL GBCDB,GBCDE ;GLOBAL DATA LOW, HIGH ADDRESSES MOV #GBCDB,PTR MOV #GBCDE,R5 JSR R5,GTRY ;LOOK FOR VARIABLES IN GLOBAL COMMON .ENDC MOV STARTV, TEMP ;GET TEMPORARY POINTER (UPPER LIMIT) MOV BOTVEC, R5 ;GET END OF "AREA". MOV TEMP, AC ;COPY THE STOP VALUE (LOWER LIMIT) CMP -(R5), -(R5) ;BE SURE LAST ENTRY DOES NOT PASS (BOTTOM). SUB R5, AC ;COMPUTE TABLE LENGTH NEGATED. MOV @SP, PTR ;COPY SUBSCRIPT ADD 2(SP), PTR ;COMBINE LETTERS PLUS SUBSCRIPT SWAB PTR ;MAKE LAST CODES FIRST! ;TAKE RESULT MODULO THE SIZE OF BIC AC, PTR ;THE SYMBOL TABLE AND BIC #7, PTR ;MODULO 10(8) ; MOV TEMP, PTR ;(CHRONOLOGICAL TO AVOID ;MESSING UP INSIDE OF INT. ARRAY) ;CHANGE #7 TO #-1 FOR A CHRONOLOGICAL TABLE. ;TEMP=START ;AC=LENGTH ;R5=LOWER LIMIT ;PTR=HASH CODE ;SEARCH VARIABLES FOR MATCH OR AN UNUSED SPACE ;PTR INITIALIZED ABOVE TO TEMP ADD TEMP, PTR ;INITIALIZE POINTER "PTR" CMPB 3(SP),#PRCNT ;LOOKING FOR AN INTEGER VECTOR HERE? BNE 17$ ;NO, LOOK FOR REGULAR VARIABLE MOV BOTTOM,R5 ;SET TOP OF STORAGE AS END MOV BOTVEC,PTR ;YES, LOOK IN VECTOR SPACE (SIC!) MOV PTR,TEMP ;SET UP LOWER LIMIT THERE TOO 17$: MOV PTR, AC ;SAVE THIS VALUE ;'TEMP' POINTS TO UPPER LIMIT ;'AC' HOLDS HASH-CODE ADDRESS ;'PTR' SCANS THE STORAGE ;'AXOUT' POINTS TO NEXT CHARACTER ;'CHAR' HOLDS LAST TERMINATOR ;'R5' HOLDS THE SCAN LOWER LIMIT JSR R5, GTRY ;SEARCH LOWER HALF MOV TEMP, PTR ;BEGIN AT THE TOP; MOV AC, R5 ;END VALUE RESTARTED. JSR R5, GTRY ;SEARCH UPPER HALF ;SEARCH FOR A ZERO-VALUE VARIABLE AND SCRATCH IT MOV BOTVEC, -(SP) ;END AT THE BOTTOM MOV TEMP, PTR ;BEGIN AT THE TOP GSWIP: CMPB 1(PTR),#PRCNT ;INTEGER DATA ARRAY? BEQ GSWIP0 ;YES, CAN'T BASH ZERO TST 6(PTR) ;ZERO? BEQ GTAKE ;YES! GSWIP0: CMPB 1(PTR),#PRCNT ;INTEGER? BNE GSWIP1 ;NO MOV 4(PTR),-(SP) ASL (SP) ADD #10,(SP) ;YES, CONSTRUCT POINTER AROUND ARRAY ADD (SP)+,PTR BR GSWIP2 GSWIP1: ADD #10, PTR ;BUMP. GSWIP2: CMP PTR, @SP ;END? BLO GSWIP ;NOT YET! ERROR+201+11.+11. ;JUST NO ROOM AT ALL! ;VARIABLE STORAGE: ;NAME: (B,A) ;SUBSCRIPT: (16) OR (8,8) : (2,1) ;LORD,EXP: (FINAL VALUE OF PTR POINTS TO THIS LOCATION.) ;HORD: (IF ZERO THEN ALL THESE PARTS ARE ASSUMED ZERO) ;"ERASEV" ERVX: MOV BOTTOM, AC ;CLEAR UP FROM THE BOTTOM MOV AC, BOTVEC ;SET VECTOR START AS TOP OF CORE 2$: CLR -(AC) ;CLEAR A WORD CMP AC, BUFR ;TEST FOR END OF VARIABLE AREA BLOS 1$ ;USE LARGER OF (AXIN) OR (BUFR) CMP AC, AXIN BHI 2$ 1$: ADD #200., AC MOV AC, STARTV RTS R5 ;GTRY ;SCAN FOR A MATCH OR A VOID. ;CALLED BY JSR R5,GTRY ;STACK CONTAINS ;*LOWER LIMIT* 0(SP) ;*SUBS* 2(SP) ;*NAME* 4(SP) ;*OLD PC*6(SP) ;PTR CONTAINS START OF VARIABLE STORE VERRJ.: JMP VERR GTRY: .IF DF,NOSTRG CMP 4(SP), @PTR ;COMPARE TRUE NAME. BEQ GTEST ;GO TEST SUBSCRIPT .IFF CMPB 5(SP),#PRCNT ;VECTOR? BNE 1$ MOV @PTR,-(SP) ;YES, FIGURE NAME ON STACK MOV @PTR,-(SP) ;FILL IN TO GET 200 BIT BIC #177577,@SP ;LEAVE ONLY 200 BIT BIC #200,10(SP) BIS (SP),10(SP) ;MAKE THE 200 BITS THE SAME TST (SP)+ ;IGNORE STRING BIT LOOKING FOR VECTOR SUB 6(SP),(SP) ;FIND OUT IF SAME AS NAME SOUGHT TST (SP)+ ;SEE IF RESULT WAS 0 AND POP STACK BR 2$ ;MERGED TEST 1$: CMP 4(SP),@PTR ;COMPARE TRUE NAME 2$: BEQ GTEST ;GO TEST SUBSCRIPT .ENDC TST @PTR ;LOOK FOR NULL BNE GTRY6 CMPB 5(SP),#PRCNT ;INTEGER DATA TYPE? ; BEQ VERRJ. ;YES, MUSTN'T GET ADDR HERE BEQ GTRY6 ;SO IGNORE NULL FOR VECTORS... TST @PTR ;LOOK FOR NULL AGAIN GTRY2: BEQ GTAKE ;GO SWIPE IT! GTRY6: CMPB 1(PTR),#PRCNT ;INTEGER TYPE? BNE GTRY3 ;NORMAL MOV 4(PTR),-(SP) ;INTEGER TYPE, SO SKIP AROUND IT ASL @SP ADD #10,@SP ;SKIP TO NEXT ADDR AFTER ;(SUBSCRIPTS START AT 0) ADD (SP)+,PTR ;TO NEXT... BR GTRY4 GTRY3: ADD #10,PTR ;FLOATING NUMBERS HOWEVER ARE FIXED GTRY4: ;SIZE... CMP PTR, @SP ;TEST LIMIT BLO GTRY ;REPEAT! RTS R5 ;NOT IN THAT AREA, RETURN. ; GTEST: CMPB 1(PTR),#PRCNT ;INTEGER? BEQ GTAKE ;YES, SO ANY SUBSCRIPT MATCHES.(TENTATIVE) CMP 2(SP), 2(PTR) ;TEST SUBSCRIPT BR GTRY2 ;TRY AGAIN ; GTAKE: MOV 4(SP), (PTR)+ ;SAVE NAME MOV 2(SP), (PTR)+ ;SAVE SUBSCRIPT ;LEAVE PTR AS POINTER CMPB 5(SP),#PRCNT ; (INTEGER TYPE CHECK??? BNE GTRY5 ; OK SO FAR .IF NDF,NOSTRG BITB #200,-4(PTR) ;STRING VECTOR? BEQ 1$ ;NO ASR 2(SP) ;YES, WORD SUBSCRIPT MUST BE 1/2 .ENDC 1$: CMP 2(SP),@PTR ; SEE IF SUBSCRIPT OK BLOS GTRY5 ;IF NOT, JMP VERR ;CALL ERROR GTRY5: ADD #6, SP ;FLUSH STACK DATA POPJ ;RETURN FROM THE "GETVAR" ROUTINE. ; ;"VARALO" ALLOCATE INTEGER VARIABLE ARRAYS. ; ; FORMATS: ; ; NORMAL INTEGERS: ; ; NAME (ASCII) ; SUBSCRIPT (1 WORD OR 2 BYTES) ; HIGH WORD (EXPONENT,LO MANTISSA) ; LO WORD (HIGH MANTISSA AND SIGN) ; ; ; INTEGER ARRAYS: ; ; NAME (ASCII), SECOND CHARACTER IS "%" ; SUBSCRIPT (1 WORD) ; MAXIMUM SUBSCRIPT (1 WORD, NUMBER OF "DATA " WORDS ; DATA(0) ; DATA(1) ; DATA(2) ; . ; . ; . ; DATA(MAX SUBSCRIPT) ; ; VARALO: ;TO ALLOCATE INTEGER ARRAY % OF SIZE NN, TYPE ;V (NN), E.G. ; ;V R(32) ; ALLOCATES A 32-WORD ARRAY NAMED "R%" ; ;THESE ARRAYS SHOULD BE ALLOCATED FIRST FOR SAFETY ; INTEGER ARRAYS ; IF MULTIPLE ARRAYS GET ALLOCATED, THAT'S TOO BAD... V.1: GETC$ ;GET A CHARACTER SPNOR$ ;IGNORE SPACE(S) CMPB CHAR,#'0 ;SEE IF A LETTER BLO V9$ CMPB CHAR,#'9 ;IF NUMBER DO EVAL BHI V9$ V8$: JSR PC,EVAL ;EVALUATE THE EXPRESSION OR NUMBER .FPP. FINT ;INTEGERIZE IT ASL AC ;ENBYTE IT MOV BOTTOM,R5 ;TOP ADDR AVAIL. FOR ALL SUB AC,R5 ;ADDR FOR START OF VECTORS MOV STARTV,AC ADD #1000,AC ;LOWEST OK ADDR CMP R5,AC ;NEW ADDR BELOW MIN? BLO 1$ ;YES, DON'T CHANGE BOTVEC MOV R5,BOTVEC ;NO, SET NEW LOW ADDR OF VECTORS 1$: JMP PROC V9$: .IF NDF,NOSTRG ;PROCESS VECTOR "R%(3) STATEMENT (MAKE STRING VECTOR) AND ; VECTOR #R%(3) STATEMENT (MAKE NUMBER VECTOR) CMPB CHAR,#'" ;STRING-MAKER? BNE 1$ ;NO,NORMAL MOV #200,-(SP) ;YES, EN-STRING BR 3$ 1$: CMPB CHAR,#'# ;INTEGER MAKER? BNE 2$ ;NO,SKIP CLR -(SP) ;YES, SET INTEGER-MAKER 3$: GETC$ ;PASS # OR " JSR PC,GETVAR ;FIND THE VECTOR CMP -(PTR),-(PTR) ;POINT AT NAME BIC #200,@PTR ;CLEAR STRING FLAG BIS (SP)+,@PTR ;AND POSSIBLY RE-SET IT. JMP PROC ;THAT'S IT... .ENDC 2$: CLR -(SP) MOVB CHAR,@SP BISB #PRCNT,1(SP) ;VAR. NAME NOW ON STACK EVALX$ ;NOW GET SUBSCRIOP .FPP. FINT ;MAKE AN INTEGER OUT OF IT MOV AC,-(SP) ;NOW WE HAVE ;2(SP) NAME ;(SP) MAX. SUBSCRIPT MOV @SP,AC ASL AC ;MAKE BYTES ADD #10,AC ;ADJUST FOR COMPLETE SIZE MOV BOTVEC,TEMP ;START OF VECTORS ; MOV STARTV,TEMP ; ;N.B. SINCE FOCAL FLOATING VARIABLES ARE4 WORDS LONG, ; DIMENSIONS OF INTEGER ARRAYS MAY BE 1,5,9,...ETC LEGALLY ; AND WILL BE ROUNDED UP ADD #7,AC ;ROUND UP BIC #7,AC ASR AC ;MAKE A MULTIPLE OF 4 ;DIMENSION NOW NEXT HIGHER MULT OF 4 MOV AC,@SP ;SAVE AS MAX. SUBSCRIPT ;BOTTOM IS HIGH ADDRESS, START IS LOWER ADDRESS VLP.1: CMP 2(SP),(TEMP) ;ALREADY GOT NAME? BEQ VERRJ ;YES, ERROR TST (TEMP) ;NO, SEE IF EMPTY SLOT YET BEQ VTAKE ;YES, GRAB IF ROOM ENOUGH CMPB 1(TEMP),#PRCNT ;BYPASS THIS ENTRY BNE VLP.2 ;NORMAL-ADD 10 MOV 4(TEMP),-(SP) ASL (SP) ADD #10,(SP) ADD (SP)+,TEMP ;POINTS AROUND ARRAY NOW BR VLP.3 VLP.2: ADD #10,TEMP VLP.3: CMP TEMP,BOTTOM BLO VLP.1 ;KEEP GOING IF NOT PAST END VERRJ: ERROR+201+44.+44. ;ERROR IF WE CAN'T DO IT VTAKE: MOV @SP,AC ;GET MAX SUBSCRIPT ADD #3,AC ;ADJUST ASL AC ;FOR HEADER TO GET SIZE OF ARRAY MOV AC,R5 ;COPY TO R5 ADD TEMP,R5 ;CONSTRUCT NEW END CMP R5,BOTTOM BHIS VERRJ ;ERROR IF TOO LARGE MOV (SP)+,4(TEMP) ;OTHERWISE SET SUBSCRIPT MOV (SP)+,(TEMP) CLR 2(TEMP) ;ALSO CLR SUBSCRIPT ENTRY MOV TEMP,R5 ;NOW GET ARRAY ITSELF ADD #6,R5 ;POINT PAST HEADER MOV 4(TEMP),TEMP ;MAX SUBSCRIPT==>TEMP MOV R5,-(SP) ;SAVE ADDR OF ELEMENT 0 VLP.5: CLR (R5)+ ;NOW CLEAR ARRAY INITIALLY DEC TEMP BGE VLP.5 ;DO ALL ARRAY ELEMENTS MOV (SP)+,R5 MOV R5,@R5 ;ADDR OF EL. 0 IN EL. 0 ADD #2,@R5 ;MAKE IT ELEMENT 1 JMP PROC ;CONTINUE THE LINE ;"PARTST" ;BE SURE PRESENT CHARACTER IS MATE TO PARENS IN THE STACK PARTSA: TST (SP)+ ;DUMP OLD 'R5' ADD #3, @SP ;COMPUTE MATCHING PARENS CMPB CHAR, (SP)+ ;COMPARE THE ACTUAL WITH COMPUTED. BEQ $PERR JMP PERR ;GO CALL "ERROR" IF TYEH DON'T MATCH $PERR: GETC$ ;MOVE ON TO THE NEXT CHARACTER JMP @R5 ;RETURN TO THE SEQUENCE ;*TYPE*ASK* ;INPUT-OUTPUT STATEMENTS TYPE: TASK ;CHECK FOR SPECIAL CODES JSR PC, EVAL ;EVALUATE EXPRESSION ; PRINT+ 40 ;MAKE LEADIN SIGNAL. MOV FISW, PTR ;LOAD FORMAT DATA .FPP. FPRINT ;PRINT SAME BR TYPE ;REPEAT STRING=74. ;NUMBER OF CHARACTERS ALLOWED ON INPUT. ASK: TASK ;CHECK FOR SPECIAL CODES JSR PC, GETARG ;READ NAME AND SETUP PTR ; PRINT+ ': ;INDICATE READY FOR INPUT DATA. MOV AXOUT, -(SP) ;SAVE TEXT POINTER MOVB CHAR, -(SP) ;SAVE VARIABLE POINTER MOV #STRING,AXOUT ;MAKE COUNTER SUB AXOUT, SP ;OPEN AREA ON THE STACK MOV SP, R5 ;SET RUBOUT STOP MOV PTR, -(SP) ;STACK THE DATA POINTER MOVB ASKZER,(R5)+ ;PACK A LEADING CHARACTER ;(NORMALLY LEADING ZERO) ;NOTE--PATCH ASKZER TO 200 (SPACE) TO PERMIT ;EXPRESSIONS TO BE ENTERED WITHOUT LEADING + OR - ;OR START EXPRESSIONS WITH LEADING + OR - SIGN ;ASKZER IS &%(1) MOV R5, AXIN ;USE FOR PACKING CLR PTR ;SET SPACE - FLOP ATAKE: READC$ ;ACCEPT CHARACTER SORTC$ TLIST,AFIX ;TEST FOR PRIME TERMINATORS DEC AXOUT ;COUNT CHARACTERS BGT 1$ ;SKIP IF OK. ERROR+201+16.+16. ;TOO LARGE AN INPUT STREAM. 1$: SORTJ$ SPECIAL,INLIST ;TEST FOR ALTMODE, SPACE, R.O., L.F. ARO: PACKC$ ;PACK INPUT AND EDIT. BMI ATAKE ;IF TERMINATOR, CONTINUE MOV @PC, PTR ;SET SWITCH SO THAT SPACE CODE BR ATAKE ;WILL TERMINATE AND ALPHA IS ACCEPTED. ; ASPACE: TST PTR ;CHECK STATUS OF SPACE. BEQ ATAKE ;IGNORE. AFIX: MOVB #214, CHAR ;PACK AN EXTRA COMMA PACKC$ ;... MOVB @PC, DEBG ;DISABLE TRACE MOV R5, AXOUT ;PICKUP DATA TSTB -(AXOUT) ;BACKUP TO LEAD ZERO. EVALX$ ;GO READ THE NUMBER OR EXPRESSION! .FPP. FPUT+THROUGH+STACK ;SAVE THE RESULT CLRB DEBG ;RE-ENABLE TRACE AGO: ADD #STRING+2,SP ;CORRECT THE STACK MOVB (SP)+, CHAR ;RESTORE TEXT SEQUENCE MOV (SP)+, AXOUT ;... BR ASK ;CONTINUE *ASK* COMMAND. ;"TASK" ;AUXILLIARY PROCESSOR FOR INPUT-OUTPUT COMMANDS TCRLF: PRINT2, CRLF ;PRINT THIS CODE FOR CR+LF. TASK4: GETC$ ;MOVE TO NEXT CHARACTER TASKX: SORTJ$ ALIST,ATLIST ;TEST FOR SPECIAL CODES (ENTRY POINT) CMPB #210, CHAR ;R-PARS AND = NOT VALID HERE ; IGNORE BLOS TASK4 ;COMMA, SEMI, AND CR WERE TESTED ABOVE RTS R5 ;RETURN ; TINTR: GETC$ ;PASS PRECENT SIGN GETLN$ ;READ FORMAT CONTROL NUMBER MOV AC, FISW ;SAVE CODE BR TASKX ;CONTINUE ; TQUOT: MOVB (AXOUT)+,CHAR ;BYPASS TRACE CMPB #CR, CHAR ;READ AND PRINT WITHIN QUOTES BEQ TASKX ;C.R.=NORMAL RETURN FROM 'TASK' CMPB #'", CHAR ;QUOTE=CANONICAL RETURN BEQ TASK4 ;GO SEE WHETHER THERE IS MORE PRNTC$ ;PRINT MATERIAL. BR TQUOT ;REPEAT ; TCRLF2: PRINT2, 00015 ;#=CR ONLY BR TASK4 ;BUT EXTRA RUB OUT. ;STRING OUTPUT FROM VECTOR. DUMPS ENTIRE VECTOR THOUGH--BE CAREFUL USING IT. TSQUT: GETC$ ;PASS QUOTE JSR PC,GETARG ;FIND VECTOR JSR R5,S.RSAV ;NOW SAVE ALL REGISTERS MOV (PTR),R5 ;MAX SUB. ASL R5 ;EN-BYTE SUB #4,R5 ;ADJUST LENGTH MOV R5,-(SP) ADD #5,PTR ;SUBSCRIPT 1 1$: MOVB (PTR)+,CHAR ;GET A BYTE JSR R5,OUT ;PRINTC DEC @SP ;COUNT CHARS TO DO BGT 1$ TST (SP)+ JSR R5,S.RRES ;GET BACK ALL REGISTERS 2$: TST CHAR ;TERMINATOR? BMI TASKX CMPB CHAR,#'' ;ANOTHER QUOTE? BEQ TASK4 GETC$ BR 2$ ;KEEP ON LOOKIN' ; ;OCTAL OUTPUT FOR PRINTING OCTAL DIGITS ; OCTOUT: GETC$ ;PASS @ MOV CHAR,-(SP) MOV R5,-(SP) ;SAVE REGS MOV R0,-(SP) MOV AXOUT,-(SP) OCTG: JSR PC,EVAL ;EVALUATE EXPRESSION .FPP. FINT ;ARG TO AC MOV AC,-(SP) ; PRINT+40 ;PRINT LEADING SPACE CLR CHAR ROL @SP ROL CHAR ;GET LEADING 0 OR 1 ADD #60,CHAR PRNTC$ ;PRINT 0 OR 1 JSR PC,RO3 ;GET 3 BITS NOW PRNTC$ JSR PC,RO3 PRNTC$ JSR PC,RO3 PRNTC$ JSR PC,RO3 PRNTC$ JSR PC,RO3 PRNTC$ ;5 MORE OCTAL DIGITS TST (SP)+ ;FIX STACK MOV (SP)+,AXOUT MOV (SP)+,R0 MOV (SP)+,R5 MOV (SP)+,CHAR OCTXIT: GETC$ ;SKIP OCTAL NUMBER BPL OCTXIT ;SKIP TILL TERMINATOR CMPB CHAR,#214 ;, ; OR CR END EXPRESSIONS BLO OCTXIT ;SEARCH TILL YOU GET ONE OF EM. JMP TASKX RO3: CLR CHAR ROL 2(SP) ROL CHAR ROL 2(SP) ROL CHAR ROL 2(SP) ROL CHAR ;GET 3 BITS ADD #60,CHAR ;CONVERT TO ASCII 0-7 RTS PC ;RETURN WITH VALUE IN CHAR ; ;FLOATING POINT HANDLER FOR FOCAL-11 ;EXTERNAL DATA IS (LORD, EXP)(HORD) ;INTERNAL DATA IS (EXP)(HORD)(LORD) ;ARITHMETIC OPERATIONS ARE NUMBERED 0-7: ;THE ADDRESSING MODES ARE NUMBERED 0-7: TRP=104000 ; .FPP. FGET=TRP+00 ;OPERATIONS ; .FPP. FAD$=TRP+10 ; .FPP. FSB$=TRP+20 ; .FPP. FDV$=TRP+30 ;DIVIDE BY ZERO ERROR ; .FPP. FML$=TRP+40 ; .FPP. FPOW=TRP+50 ;NEGATIVE POWER ERROR ; .FPP. FPUT=TRP+60 ;EXPONENT ERROR ; ; .FPP. FNOR=TRP+70 ;FUNCTIONS ; .FPP. FINT=TRP+71 ; .FPP. FSG$=TRP+72 ; .FPP. FAB$=TRP+73 ; .FPP. FNG$=TRP+74 ; .FPP. FREAD=TRP+75 ; .FPP. FPRINT=TRP+76 ; .FPP. FZER=TRP+77 ;100 TO 177 UNUSED ; ; .FPP. FCODE=TRP+200 ;COMPUTED OPERATION IN AC ;201 TO 377 UNUSED IPTR=1 ;@PTR XPTR=2 ;AUTO INDEX PTR BY TWO WORDS. INTO=3 ;STACK FROM=3 ;STACK THROUGH=4 ;STACK IMMED=5 ;DATA FOLLOWS REL=6 ;RELATIVE (ADDR-.) STACK=0 ;ADDRESSING MODES DIRECT=0 ;ABSOLUTE (FAD$ + DIRECT,ADDR) (NON-P.I.C.) ;"DIRECT" AND "INDEX" ARE FOLLOWED BY COMMA AND ADDRESS. ;FOCAL-11 FLOATING POINT HANDLER FPPTRP: ;.FPP. MACRO GIVES JSR PC,FPPTRP MOV (SP),-(SP) ;FAKE TO LOOK LIKE TRAP CLR 2(SP) ;FAKE OLD PSW ;NOTE C.C. NOT SAVED HERE. MAY HAVE TO FIX! ADD #2,@SP ;PASS FPP CODE ;FALL THRU AND INTERPRET CODE BR FTRP+2 ;SKIP EMT FLUSH OF TOP OF STACK FTRP: TST (SP)+ ;FLUSH TOP OF STACK (CODE) ;FTRP+2 IS WHERE 7000-BASED CALLS COME IN, MERGED. MOV %5, -(SP) ;SAVE ALL REGS. MOV %4, -(SP) ; MOV %3, -(SP) ; MOV %2, -(SP) ; MOV %1, -(SP) ; MOV %0, -(SP) ; MOV 14(SP),TEMP ;PICKUP ADDR OF LOC. AFTER CALL. MOVB -2(TEMP),AL ;PICKUP CODED BYTE. BPL FPURE ;TEST FOR CALCULATED CODES. MOV AC, AL ;YES, USE THOSE INSTEAD. FPURE: MOVB AL, -(SP) ;SAVE A COPY OF IT. CMPB #070, @SP ;TEST FOR FUNCTION CALL BLE FLTDO ;SKIP ADDRESS FORMATION BIC #-10, AL ;LEAVE THE ADDRESS MODE BITS. MOVB INADDR(AL),AL ;MAKE INDEX FOR ADDRESS FORMATION ROUTINES. ADD AL, PC ;SETUP "PTR" AS DATA POINTER. FLTDO1: MOVB (PTR)+,AC ;GET THE DATA (AE=AC) MOVB (PTR)+,AL ;LOW ORDER 8 BITS SWAB AL ;LEFT SHIFT 8 CLRB AL ;... MOV @PTR, AH ;HIGH ORDER BYTE. FLTDO: MOVB @SP, TEMP ;LET'S TRY THOSE CODES MOV PTR, -(SP) ;SAVE POINTER FOR "PUT" MOV HORD, BH ;SETUP THE FLOATING AC MOV LORD, BL ;... CLRB BL ;... ASRB TEMP ;AGAIN. ASRB TEMP ;MAKE AN EVEN TABLE ADDRESS BIC #177761,TEMP ;CLEAR LEFT HALF JSR PC, @OPADDR(TEMP) ;DO THE OPERATION! JSR PC, NORF ;NORMALIZE IT. MOV BL, LORD ;SAVE RESULTS MOV BH, HORD ;... FLTX: CMP (SP)+, (SP)+ ;DUMP THE POINTER AND THE CODES BR PWREGS ;AND EXIT ;"FPUT" PUTF: TST (SP)+ ;IGNORE RETURN FROM THIS ONE. MOV @SP, TEMP ;GET THE POINTER BACK MOV BH, @TEMP ;SAVE HIGH ORDER PART MOV BE, AH ;COPY "(BE)" FOR SAVE AND TESTS. SWAB BL ;POSITION LOW ORDER BYTES. MOVB BL, -(TEMP) ;... MOVB AH, -(TEMP) ;SAVE HALF OF EXPONENT. BPL 1$ ;TEST FOR ALL SIGN BITS. COM AH ;... 1$: SWAB AH ;CHECK HIGH ORDER EXP. BEQ FLTX ;OK=RETURN ERROR+201+12.+12. ;NO=EXP OVER 38! ;ADDRESS MODES INADDR: .BYTE EMDIR -FLTDO1 ;ADDRESS FOLLOWS. .BYTE FLTDO1-FLTDO1 ;"PTR" CONTAINS ADDRESS. .BYTE EMIND -FLTDO1 ;((PTR)+4) IS THE ADDRESS . .BYTE TRPO -FLTDO1 ;STACK HAS DATA .BYTE TRPHR -FLTDO1 ;STACK HAS ADDRESS .BYTE EMIME -FLTDO1 ;DATA FOLLOWS .BYTE EMREL -FLTDO1 ;((TEMP)) IS ADDRESS - (TEMP) .BYTE NOP -FLTDO1 ; ;BYTES ABOVE MUST BE LESS THAN 177. ; EMDIR: MOV @TEMP, PTR ;TO THE PC1 AND PICKUP "X" ADD #2, 16(SP) ;MOVE PC1 POINTER PAST DATA. BR FLTDO1 ;RETURN TO HANDLER. EMIME: ADD #4, 16(SP) ;THEN MOV TEMP, PTR ;COPY ADDRESS OF DATA. BR FLTDO1 ;INDEX THROUGH THE STACK. TRPO: MOV SP, PTR ;INDEXES THROUGH THE STACK. ADD #22, PTR ;MOVE POINTER TO JOB. BR FLTDO1 ;GO USE IT. EMIND: CMP (PTR)+, (PTR)+ ;AUTO INDEX THE POINTER MOV PTR, 6(SP) ;COPY AND UPDATE PTR. BR FLTDO1 ;CONTINUE. TRPHR: MOV 22(SP), PTR ;USE JOB AS THE ADDRESS. BR FLTDO1 ;CONTINUE EMREL: ADD @TEMP, TEMP ;COMPUTE ABSOLUTE ADDRESS. MOV TEMP, PTR ;USE THAT RESULT. BR EMDIR+2 ;GO MOVE PC. AC0=%0 AC1=%1 AC2=%2 AC3=%3 ;FPP ACCUMULATORS ;POWER-FAIL PWRDWN: TST WHOOPS ;CHECK FOR POWER-FAIL OR AUTO-RESTART. BNE PWRUP ;IF NON-ZERO, THEN IT IS POWER-UP. MOV %5, -(SP) ; MOV %4, -(SP) ;SAVE 0-5. MOV %3, -(SP) ; MOV %2, -(SP) ; MOV %1, -(SP) ; MOV %0, -(SP) ; MOV SP, WHOOPS ;FINALLY SAVE THE STACK POINTER HIMSELF.** NOP: HALT ;STOP THE PROCESS; FALL-THROUGH FOR FAILSAFE. ;AUTO-RESTART PWRUP: MOV WHOOPS, SP ;RELOAD THE STACK POINTER CLR WHOOPS ;RESET THE SWITCH MOV @PC, @#TKS ;RESTORE INTERRUPT ENABLE! PWREGS: MOV (SP)+, %0 ; MOV (SP)+, %1 ; MOV (SP)+, %2 ; MOV (SP)+, %3 ; MOV (SP)+, %4 ; MOV (SP)+, %5 ;RESUME PROCESS AND RESTORE THE STATUS. PWRON: RTI ;... ;FOR DEBUGGING WITH SINGLE STEP. (NOT REENTRANT) ; TST (SP)+ ;MOVE POINTER ; MOV (SP)+, STATUS ;RESTORE STATUS ; MOV -6(SP), PC ;LET THIS INST BE EXECUTED, THEN TRAP. .IF DF,FPP11A FPP11=0 .ENDC ;NORMALIZE RESULT AFTER DOING AN OPERATION. NORF: TST BH ;TEST FOR ZERO BNE NORM2 ;OBVIOUSLY THERE SO SHIFT TST BL ;CHECK LOW PART. BEQ NORMZ ;RESULT IS ZERO! NORM2: DEC BE ;ROTATE LEFT FOR THE TEST ASL BL ;TAKE CARE OF 2-DONE CASES: ROL BH ;0.1XXX ;V=1 BVS NORMD ;1.0XXX ;V=1 BPL NORM2 ;0.0 TEST BIT #77777, BH ;1.100,XXX-? BNE NORM2 ;NO! SEC ;YES=NEG. POWER OF 2 NORMD: ROR BH ;RESTORE TO PROPER PLACES. ROR BL ;... INC BE ;--- ADD #200, BL ;ROUND ADC BH BVS NORMD .IF DF,FPP11A BIC #377,BL .ENDC RTS PC ;RETURN GETF: MOV AC, BE ;COPY THE OPERAND. MOV AH, BH MOV AL, BL RTS PC OPADDR: GETF ;FLOATING POINT OPERATOR HANDLERS. ADD$ SUB$ DIV$ MUL$ POWF PUTF NORX FNADDR: INTY ;FLOATING POINT FUNCTION HANDLERS INTF SGNF ABS$ NEG$ READF PRNTF INTZ MULZ: ADD #6, SP ;DUMP 'SIGN+COUNT+OLD RETURN'. NORMZ: CLR BE CLR BH CLR BL RTS PC NORX: MOVB 4(SP), AC ;LOOK WHO'S HERE! BIC #-10, AC ;USE FUNCTION CODES TO ASL AC ;FORM WORD ADDRESS IN TABLE AND JMP @FNADDR(AC) ;JUMP TO THE FUNCTION PROCESSES. ;FUNDAMENTAL FLOATING POINT ROUTINES SUB$: NEG AH ;SUBTRACT LOW ORDER. NEG AL ;SUBTRACT LOW CARRY. SBC AH ;FINISH W/O OVERFLOW CHECK ;ALIGN AND ADD ROUTINE ;IF A=0 , USE B ;IF B=0 , USE A ;SET AC=X(A)-X(B) ;IF !X(A)-X(B)!>30., USE LARGER OF X(A) OR X(B) ;SET A=A/2 ;SET B=B/2 <-. ;IF AC=0, GO ADD . ;IF AC>0, SET AC=AC-1; --. ;IF AC<0, SET AC=AC+1; A=A/2; .IF NDF,FPP11A ADD$: TST AH ;TEST FOR A=0 BEQ INTY ;USE B TST BH ;TEST FOR B=0 BEQ GETF ;USE A MOV #BE, TEMP ;CREATE EXP. POINTER. SUB @TEMP, AC ;COMPARE EXPONENTS BLE ALIGNA ;AND SAVE COUNT. CMP #30., AC ;TEST FOR POSSIBILITY THAT BLE ALTAKA ;A IS TOO LARGE =USE A. ALIGNB: ASR BH ;SHIFT DOUBLE B TO ROR BL ;THE RIGHT AND ADD TO INC @TEMP ;THE EXPONENT DEC AC ;COUNT THE SHIFTS BGT ALIGNB ;TEST FOR RE (AC>0) ALIGNA: CMP #-29., AC ;TEST RELATIVE SIZE BGE ALGZA ;B IS TOO LARGE = EFFECTIVE ZERO A. 1$: ASR AH ;SHIFT OVER ROR AL ;... INC AC ;COUNT SHIFTS BLE 1$ ;REPEAT UNTIL EXTRA 1 DONE. ASR BH ;GIVE AN EXTRA SHIFT ROR BL ;TO THE RESULT TO INC @TEMP ;AVOID OVERFLOW. BUMP THE EXP. ADD AL, BL ;LEAVE RESULT IN B. ADC BH ;ADD THE LOW ORDER CARRY ADD AH, BH ;FINISH W/O OVERFLOW CHECK BR ALGZA ;RETURN FOR NORM, ETC. OF SMALL DIFFERENCES. ; ALTAKA: ADD AC, @TEMP ;CORRECT THE EXPONENT BR GETF+4 ;GO COPY THE DATA .IFF ADD$: MOV BH,HORD ;GET 1ST WORD MOV BL,LORD JSR PC,XS2H ;MAKE FLOATING IN AC0 STF AC0,AC1 ;COPY MOV AC,BE MOV AH,HORD MOV AL,LORD JSR PC,XS2H ;GET # IN AC0 ADDF AC1,AC0 ;ADD THE TWO JSR PC,XH2S ;MAKE FOCAL FPP FORMAT AGAIN MOV HORD,BH MOV LORD,BL BR ALGZA ;UPDATE AL,AH .ENDC ;FINT (BE,BH,BL)=> (31.,BH) INTF: MOV #BE, AC ;CREATE EXP. POINTER TST @AC ;MAKES B INTO AN BLE INTZ ;INTEGER BUT LEAVES INTG: CMP #31., @AC ;THE EXPONENT CORRECT. BLE INTX ;NO CHANGE POSSIBLE NOW. ASR BH ;BRING IN SIGN BIT LEFT. ROR BL ;ROTATE DP UNTIL INC @AC ;THE EXPONENT CONTAINS BR INTG ;31 DECIMAL. ; INTZ: JSR PC, NORMZ ;LEAVE ZERO RESULT INTX: MOV BL, 8.(SP) ;COPY INTO THE COPY OF "AC" INTY: RTS PC ;RETURN ONE MORE LEVEL ; ZERODM: ADD #12, SP ;DUMP 'BH','R5','R5','PTR', AND 'CODES'. BR PWREGS ;GO RESTORE REGISTERS. XABS: .FPP. FAB$ ;SIMPLE CALLS FOR SIMPLE FUNCTIONS RTS PC XSGN: .FPP. FSG$ RTS PC XITR: MOV HORD, -(SP) ;SAVE SIGN .FPP. FAB$ ;ABS. .FPP. FINT TST (SP)+ BPL 1$ .FPP. FNG$ 1$: RTS PC ;THE FOLLOWING THREE PAGES CONTAIN ;"FML$","FDV$","FSG$","FNG$","FAB$", AND "FPOW". ;(2 WORD)*(2 WORD) MULTIPLY ROUTINE ;(TEMP,AC,BH,BL)*(AH,AL)=>(0,0,BH,BL;!AH,AL!) .IF NDF,FPP11A MUL$: JSR PC, SIGN ;COMPUTE SIGN OF RESULT AND SAVE. BEQ MULZ ;RESULT IS ZERO IF A IS ZERO. MDP0: ASR BH ;... ROR BL ;... BCC 1$ ;NO CARRY=NO ADD ADD AL, AC ;UPDATE THE RESULT ADC TEMP ;... ADD AH, TEMP ;... 1$: ROR TEMP ;PUT IT DOWN ONCE. ROR AC ;... DEC @SP ;COUNT BITS. BNE MDP0 ;REPEAT. .IFF MUL$: MOV BH,HORD MOV BL,LORD ;MOVE # TO FLAC TO CONVERT JSR PC,XS2H ;CONVERT TO AC0 FPP # STF AC0,AC1 ;COPY MOV AC,BE MOV AH,HORD MOV AL,LORD JSR PC,XS2H MULF AC1,AC0 ;MULTIPLY JSR PC,XH2S ;MAKE FOCAL FMT NOW MOV HORD,BH MOV LORD,BL BR ALGZA ;UPDATE AL,AH .ENDC SIGND: MOV TEMP, BH ;COPY THE RESULT. MOV AC, BL ;... SUB (SP)+, (SP)+ ;RESTORE THE SIGN OF BPL BDIVX ;THE RESULT. NEGX: NEG BH ;LEAVE A NEGATIVE RESULT NEG BL ;... SBC BH ;... BDIVX: ADD #1, BL ;ROUND ADC BH ;... TST (SP)+ ;DUMP OLD RETURN ADDRESS (OR DATA SAVED) ALGZA: MOV BL, AL ;COPY RESULT MOV BH, AH ;TO TEST SIZE. BPL ALGZB ;TAKE ABSOLUTE VALUE. NEG AH ;... NEG AL ;... SBC AH ;... ALGZB: BNE 1$ ;CHECK FOR HIGH ORDER WORD NOT ZERO. SWAB AL ;CHECK FOR LOW BYTE NOT ZERO, BEQ NORMZ ;MAKE ALL ZERO RESULT. 1$: RTS PC ;AND GET BACK TO THIS LEVEL. ; SGNF: MOV BH, -(SP) ;SAVE HIGH ORDER PART. BEQ ALGZA-2 ;SIGN OF ZERO IS ZERO. SGN1: MOV #1, BE ;CREATE A FLOATING ONE. MOV #40000, BH ;... CLR BL ;... TST @SP ;TEST THE SIGN OF STACK ENTRY. BR NEGX-2 ;GO TEST FOR RESULT. ; ABS$: TST BH ;TEST B AND PUT DUMMY ON STACK. BPL SGNF-2 ;GO USE OTHER BRANCH. NEG$: JSR PC, NEGX ;DOES NOT RETURN HERE;DUMMY ON STACK. ; ;(4 WORD)/(2 WORD) DIVIDE ROUTINE ;(0,0,BH,BL)/(AH,AL)=> BH,BL;!AH,AL! .IF NDF,FPP11A DIV$: NEG AC ;TAKE DIFFERENCE OF EXPONENTS INC AC ;PLUS ONE. JSR PC, SIGN ;MAKE SIGN OF RESULT ABS. VALS. ;ADD TEMP+AC. ADD WITH COUNTER BEQ DIVZER ;DIVIDE BY ZERO! DIFL: SUB AL, BL ;USE A TEMPORARY RESULT SBC BH ;MAKE A TRIAL RUN CMP BH, AH ;CONTINUE THE ILLUSION BMI 1$ ;COMPUTE INTERMEDIATE VALUE. SUB AH, BH ;BRANCH IF NO-ACTUAL CARRY. SEC ;NO-GO=UPDATE HIGH BR 2$ ;NO-GO=UPDATE LOW 1$: ADD AL, BL ;SET UP THE CARRY DATE FOR ROTATE ADC BH ;SKIP CLC ;DUMP TRIAL RESULT+CLEAR CARRY 2$: ROL AC ;ROTATE ALL ROL TEMP ;ROTATE ALL ASL BL ;ROTATE ALL ROL BH ;ROTATE ALL DEC @SP ;COUNT BNE DIFL ;REPEAT THE LOOP BR SIGND ;GO DOCTOR THE SIGN ; .IFF DIV$: MOV BH,HORD MOV BL,LORD JSR PC,XS2H STF AC0,AC1 MOV AC,BE MOV AH,HORD MOV AL,LORD JSR PC,XS2H TSTF AC0 ;CHECK 0 DIVISION CFCC BEQ DIVZER ;0 DIVISION ILLEGAL DIVF AC0,AC1 ;DIVIDE AC1 BY AC0 STF AC1,AC0 ;COPY RESULT TO AC0 JSR PC,XH2S ;FOCAL FORMAT NEXT MOV HORD,BH MOV LORD,BL BR ALGZA ;DONE .ENDC DIVZER: ERROR+201+14.+14. ;DIVISION BY ZERO NOT ALLOWED. ;INTEGER EXPONENT CALCULATIONS POWF1: ASR AH ;REDUCE TO INTEGER INC AC ;COUNT SHIFTS POWF: CMP #15., AC ;TEST FOR RANGE OF POWER BLO FERRO ;OUT OF THE RANGE, FRACTIONAL BNE POWF1 ;GO TAKE INTEGER PART OF A. MOV AH, -(SP) ;SAVE THE COUNT (COULD BE ZERO) BMI FERRO ;TEST FOR NEGATIVE POWER. BEQ SGN1 ;INITIALIZE MULTIPLICAND TO ONE MOV BH, -(SP) ;COPY THE BASE POWS: BEQ ZERODM ;DON'T LET FML$ SEE ZERO! MOV BE, -(SP) ;SAVE EXPONENT OF THE BASE MOV BL, -(SP) ;INTO ARGUMENT POSITION POWDO: MOV (SP)+, AL ;RESTORE EXP. OF THE BASE MOV (SP)+, AC ;... MOV (SP)+, AH ;... DEC @SP ;COUNT ON THE STACK. BEQ BDIVX ;FINISHED! MOV AH, -(SP) ;SAVE EXP MOV AC, -(SP) ;... MOV AL, -(SP) ;... JSR PC, NORM2 ;NORMALIZE FOR ACCURACY. JSR PC, MUL$ ;MULTIPLY ONCE BR POWDO ;REPEAT ; FERRO: ERROR+201+15.+15. ;TOO LARGE OR NEGATIVE POWER! .IF NDF,FPP11A ;COMPUTE SIGN OF RESULT FOR MUL/DIV. ;ALSO SAVE THAT SIGN ON THE STACK. SIGN: MOV BH, -(SP) ;FIND SIGN OF RESULT BEQ POWS ;RESULT IS ZERO IF B IS ZERO. BIC #077777,@SP ;AS THE XOR OF ARGUMENT'S ADD AH, @SP ;SIGNS! ADD AC, BE ;COMPUTE EXPONENT CLR TEMP ;CLEAR THE HIGH SIDE OF MUL-DIV CLR AC ;... MOV #31., -(SP) ;CREATE BIT COUNTER TST BH ;TAKE ABSOLUTE VALUES BGE 1$ ;TAKE ABSOLUTE VALUES NEG BH ;NEGATE B NEG BL ;NEGATE B SBC BH ;NEGATE B 1$: TST AH ;TEST SECOND ARGUMENT BGE 2$ ;TEST SECOND ARGUMENT NEG AH ;NEGATE A NEG AL ;NEGATE A SBC AH ;NEGATE A 2$: JMP @4(SP) ;GO BACK .ENDC ;"FPRINT" ;FLOATING POINT OUTPUT CONVERSION FUNCTION ;[RE-ENTRANT!] ;FORMAT DATA IS TAKEN FROM "PTR" ;THIS PAGE PRODUCES A 7 DIGIT STRING PLUS LEADING ZEROS. PRNTF: CLR -(SP) ;OPEN PLACE FOR EXPONENT OF TEN. MOV #40, CHAR ;SETUP LEADING SPACE TST BH ;TAKE THE ABSOLUTE VALUE BGT FLOSGN ;PRINT SPACE FOR POSITIVE NUMBER. BEQ FOGO3 ;PRINT ALL ZEROS .FPP. FNG$ ;NEGATE THE NEGATIVE FLAC ADD #15, CHAR ;CREATE MINUS SIGN FLOSGN: MOV #BE, AC ;CREATE POINTER TO EXPONENT INC @SP FOGO1: CMP @AC, #4 BLT FOGO2 BGT PTN.M2 CMPB 1+HORD, #120 BLT FOGO3 PTN.M2: .FPP. FML$+IMMED PTEN: 064375,063146 BR FOGO1-2 ;REPEAT FOGO2: TST @AC BGT FOGO3 DEC @SP .FPP. FML$+IMMED TEN: 4,50000 BR FOGO1 ;TEST RANGE FOR 0-4 FOGO3: CLR -(SP) ;EXTRA HOLE FOR CARRY. PRNTC$ ;PRINT SIGN. MOV #FLARG, PTR ;SET TEMPORARY POINTER MOV #7., TEMP ;SETUP 7D COUNTER FOGO4: .FPP. FPUT+IPTR ;ROUND LSB AND SAVE .FPP. FINT ;GET THE DIGIT MOV AC, -(SP) ;STACK RESULTS .FPP. FNG$ ;REMOVE THE DIGIT .FPP. FAD$+IPTR ;... .FPP. FML$+DIRECT,TEN ;AND DIG OUT THE NEXT DIGIT. DEC TEMP ;COUNT DIGITS BGT FOGO4 ;AND TRY AGAIN CLR -(SP) ;OPEN SPACE FOR FORMAT DATA (VIA "PTR") MOVB 36(SP), @SP ;GET DECIMAL PART OF %X.0Y. (OLD "PTR") MOV #177400,-(SP) ;ADD CORRECTION FACTOR. .FPP. FGET+FROM+STACK ;COMPUTE THE FRACTION .FPP. FML$+IMMED ;SCALE STEP NOS. BY 16,062000 ;100.X2^7 .FPP. FINT ;... CLOSE+STACK ;RESULT IS IN "AC" ;NO MORE CALLS TO FLOAT. ;COMPUTE THE L.S.D. POSITION MOV SP, R5 ;START POINTER MOVB 35(SP), F ;COPY TOTAL DIGITS REQUESTED. MOV 20(SP), E ;DIG UP THE NUMBER OF INTEGER DIGITS COMPUTED. CMP F, AC ;CORRECT FOR ILLOGICAL REQUESTS BGT .+6 ;OF DECIMALS > FIELD SIZE. MOV F, AC ;... DEC AC ;AC=F-1 MOV AC, CHAR ;USING E FORMAT? MOV #6, P ;INIT. SIX DIGIT OUTPUT. CMP F, E ;ENOUGH SPACE? BGE 1$ ;SKIP TO YES. CLR F ;NO, USE E FORMAT. 1$: TST F ;ASK QUESTION BEQ TOF ;YES, MOVE AHEAD, AOK. ADD E, AC ;D+E CMP F, AC ;F < D+E? BGE TOG ;I.E. ENOUGH SPACE? MOV F, AC ;ANY DIGITS VISIBLE? TOG: CMP AC, P ;MUST BE LESS THAN SIX. BGE TOF ;KEEP 6 IN P. MOV AC, P ;YES, ROUND TO D+E BGE TOF ;YES, USE P CLR P ;NO, ROUND LEAD DIGIT. TOF: MOV P, AC ;SAVE NO. OF AVAILABLE DIGITS COM P ;P = -(P+1) TO ROUND ASL P ;COMPUTE WORD INDEX TO +5 ROUND. MOV #16, -(SP) ;INDEX FOUND ADD R5, @SP ;COMPUTE END ADDRESS ADD @SP, P ;COMPUTE +5 ROUND ADDRESS. ;ROUND THE B.C.D'S TOT: INC @R5 ;FUDGE FACTOR CMP R5, P ;SPECIAL ROUNDUP FACTOR BNE TOR ;TEST FOR THERE ALREADY ADD #5, @R5 ;ROUND BY +5 TOR: CMP #10., @R5 ;OVERFLOW CAUSE BGT TOS ;SKIP IF OK SUB #10., (R5)+ ;CORRECT FOR OVERFLOW BR TOT ;AND CARRY TOS: TST (R5)+ ;BUMP THE POINTER. CMP R5, P ;TEST FOR ROUNDOFF START BEQ TOR-4 ;GO DO IT. CMP @SP, R5 ;TEST FOR END. BGT TOS ;REPEAT BEQ 1$ ;SKIP IF NO CARRY ONE. INC E ;UPDATE "E" INC AC ;AND FIELD SIZE. 1$: JSR PC, FPRNT ;CALL OUTPUT ROUTINE ADD #24, SP ;CORRECT STACK BR FIGO4 ;AND RETURN TO TOP LEVEL. ;FIXED POINT OUTPUT FORMAT FPRNT: MOV F, P ;USE LARGER OF F-D OR E BEQ FLOUT ;TEST FOR FLOATING POINT FORMAT SUB CHAR, P ;COMPUTE INTEGER PLACES REQUESTED CMP P, E ;FORMAT OK? BGE FPRNTP ;YES, GO DO IT. MOV E, P ;SHIFT DECIMAL POINT RIGHT CMP E, F ;BUT NOT TOO FAR! BGT FLOUT ;GO USE "E" FORMAT ANYWAY. FPRNTP: CLR CHAR ;0 CMP P, E ;TEST DISTANCE TO DOT. BGT FTRY ;GO LINE UP A DIGIT DEC E ;COUNT DOWN INTEGER DIGITS DEC AC ;COUNT DOWN STRING DATA. BLT LTZERO ;PRINT TRAILING ZERO MOV -(R5), CHAR ;GET AN ACTUAL DIGIT LTZERO: JSR PC, PRNT1 ;OR A REAL DIGIT. DEC F ;COUNT DOWN THE FIELD. BLE DXIT ;BRANCH IF END OF DATA FORMAT. DEC P ;COUNT DOWN DISTANCE TO DOT. BNE FPRNTP ;THERE YET? PRINT+ '. ;YES BR FPRNTP ;CONTINUE ; FTRY: CMP P, #1 ;PRINT AT LEAST 0 BLE LTZERO ;... MOV #40-60, CHAR ;OR A LEADING SPACE BR LTZERO ;... ;FLOATING POINT OUTPUT FORMAT FLOUT: MOV E, -(SP) ;SAVE POWER OF TEN FOR LATER. CLR E ;0.XXXX MOV #1, P ;... MOV #7, F ;FIELD SIZE JSR PC, FPRNTP ;PRINT FIRST DIGIT GROUP PRINT+ 'E ;E+-XXX MOV (SP)+, PTR ;LOOK AT EXPONENT AGAIN PRNTS: BGE PRNTP-2 ;GO PRINT SIGN. NEG PTR ;CORRECT E TO ABSOLUTE VALUE PRINT+ '- ;PRINT SIGN. BR PRNTP ;FALL INTO DIGIT PRINT ROUTINE. PRINT+ '+ ;... PRNTP: DIGTS$ 100. ;PRINT 2 OR 3 DIGITS CMPB CHAR, #60 ;... BEQ PRNT2 ;IGNORE FIRST ZERO. PRNTC$ ;... PRNT2: DIGTS$ 10. ;PRINT 2 DIGITS FOR SURE PRNTC$ ;... MOV PTR, CHAR ;PRINT LAST DIGIT PRNT1: ADD #60, CHAR ;... PRNTC$ ;... DXIT: POPJ ;AND RETURN. ;END OF OUTPUT CONVERSION ROUTINES ;"FREAD" ;FLOATING POINT INPUT CONVERSION FUNCTION ;[RE-ENTRANT] READF: MOV 14(SP), AXOUT ;(THIS CODE IS NOT RE-ENTRANT!) JSR PC, DECONV ;CONNECT FIRST DIGIT GROUP CLR PTR ;START FRACTION COUNTER. CMPB CHAR, #'. ;DID IT END IN PERIOD? BNE FIGO1 ;NO, GO FINISH THE ANSWER JSR PC, DECON1 ;COUNT DIGITS AND APPEND RESULT. FIGO1: MOV PTR, -(SP) ;OPEN SPACE ON THE STACK ;FOR NO. OF DEC. DIGITS. BITB #NALPHA,SWITCH ;FROM GETLN? BEQ FIGO2 ;YES, LEAVE CMPB CHAR, #'E ;DID IT END WITH "E"? BNE FIGO2 ;NO, GO EXIT .FPP. FPUT+DIRECT, FLARG ;YES, SAVE PRESENT RESULT GETC$ ;READ ON PAST THE 'E'. JSR PC, DECONV ;READ EXPONENT TST AC ;CORRECT FOR SIGN OF EXPONENT. BMI 73$ ;... .FPP. FNG$ ;... 73$: .FPP. FINT ;MAKE AN INTEGER IN 'AC' ADD AC, @SP ;SAVE EXPONENT AND USE AS COUNTER .FPP. FGET+DIRECT, FLARG ;RECOVER VALUE OF DECIMAL FRACTION FIGO2: MOV #PTEN, PTR ;INITIALIZE CORRECTION POINTER MOV (SP)+, AC ;TEST THE SIGN OF THE EXPONENT BPL FIGOE ;IF -,CORRECT BY *.10 NEG AC ;TAKE ABS. VAL. OF THE EXP COUNT. MOV #TEN, PTR ;IF +, CORRECT BY *10. FIGOE: DEC AC ;DO THE CORRECTION. BLT FIGO3 ;LEAVE WHEN FINISHED. .FPP. FML$+IPTR ;CORRECT FLAC VIA POINTER ON THE STACK. BR FIGOE ;REPEAT UNTILL EXPONENT COMPLETED. ; FIGO3: MOV CHAR, 16(SP) ;INTERNAL DATA=YES. ;COPY TERMINATING CHARACTER. MOV AXOUT, 14(SP) ;COPY TEXT POINTER FIGO4: TST (SP)+ ;LEAVE VALUE JMP FLTX ;TO BE RESTORED AT "PWREGS" ;CONVERT A GROUP OF NUMBERS. DECONV: .FPP. FZER ;CLEAR INITIAL VALUE AND 'AC' CMPB CHAR, #201 ;+? BEQ DECON1 ;YES CMPB CHAR, #202 ;-? BNE DECNP2 ;NO COM AC ;YES-REVERSE SIGN DECON1: GETC$ ;GET NEXT CHARACTER DECNP2: TSTB CHAR ;CHAR FOR 'TERMS' BMI DXIT ;LEAVE ON THE TERMINATOR CMPB CHAR, #'. ;TEST FOR GROUP TERMINATOR BEQ DXIT ;AND LEAVE IF FOUND CMPB CHAR,#'@ ;@?? OCTAL IF SO BEQ OCTIO SKPNO$ DETN ;CHECK FOR NUMBER BITB #NALPHA,SWITCH ;TEST FOR ALPHA AS TERM. BEQ DXIT ;CLEAR=YES. IF =1 THEN CAN'T BE E-FORMAT EITHER. CMPB CHAR, #'E ;CHECK FOR SPECIAL FORMAT BEQ DXIT ;... BIC #-40, CHAR ;CLEAR HIGH ORDER BITS OF "A-Z" ASCII CODES. DECOY: MOV CHAR, -(SP) ;SAVE THIS DIGIT ON STACK MOV #15., -(SP) ;LOAD INTEGER EXPONENT ONTO STACK .FPP. FML$+DIRECT, TEN ;MULTIPLY PRESENT VALUE BY 10 .FPP. FAD$+FROM+STACK ;ADD IN NEW DIGIT CLOSE+STACK ;REMOVE ARG. FROM STACK. DECON2: INC PTR ;COUNT DIGITS BR DECON1 ;GO BACK FOR MORE, ; DETN: BIC #-20, CHAR ;USE BCD PART OF ASCII NUMBER. BNE DECOY ;GO USE THE DIGIT IF NON-ZERO. .FPP. FML$+DIRECT,TEN ;UPDATE PRESENT VALUE BR DECON2 ;REPEAT. ; ;OCTIO--READ CHARACTER IN OCTAL ; OCTIO: GETC$ ;PASS @ BMI OCTX ;SEE IF LEGAL SKPNO$ OCTN ;INCOMPLETE CHECK--SEE IF NUMBER OCTX: RTS PC OCTN: BIC #-20,CHAR ;SET HIGH BITS 0 MOV CHAR,-(SP) ;SAVE ON STACK MOV #15.,-(SP) ;INTEGER EXPONENT .FPP. FML$+IMMED ;MULT OLD VALUE BY 8 EIGHT: 4,40000 ;IN CRAZY INTERNAL CODE .FPP. FAD$+FROM+STACK ;ADD IN THIS NUMBER CLOSE+STACK ;FIX SP INC PTR BR OCTIO ;KEEP LOOPING TILL DONE .IF DF,FPP11 ; ;FUNDAMENTAL FLOATING CONVERTERS BETWEEN FOCAL INTERNAL AND HARDWARE ;FLOATING POINT REPRESENTATIONS OF NUMBERS. ; ; ; XS2H ; SOFTWARE TO HARDWARE CONVERTER ; INPUT: FLOATING AC (BE, HORD, LORD) ; OUTPUT: FLOATING ACCUMULATOR AC0 AC0=%0 AC1=%1 AC2=%2 AC3=%3 AC4=%4 AC5=%5 XS2H: SETL SETF ;HORD,LORD FORM A 32-BIT LONG INTEGER. LOAD IT AS A FLOATING NUMBER, ;THEN LOAD THE PROPER EXPONENT USING LDEXP. ; ;FIRST BE SURE FOCAL FORMAT IS NORMALIZED OR THIS ALGORITHM FAILS... ; BIT #40000,HORD ;H.O. BIT MUST BE ON BNE 10$ ;IT IS--WE'RE OK ;UN-NORMALIZED NUMBER!!! ;FOCAL EXPONENT WILL BE WRONG--HAVE TO FIX IT HERE. .IF DF,FPP11A ;FIRST SEE IF IT'S JUST AN INTEGER (HORD=#, BE=17,LORD HI BYTE=0) CMP BE,#17 ;SEE IF EXPONENT RIGHT BNE 22$ ;NO, DO FULL NORMALIZE TSTB LORD+1 ;ANY FRACTIONAL PART? BNE 22$ ;IF SO, BRANCH. SETI ;ELSE SET 16-BIT INTEGERS LDCIF HORD,AC0 ;AND MAKE THE NUMBER FLOATING... SETL BR 1$ ;AND GO AWAY, SINCE ALL DONE. .ENDC ;SPEED UP IF USING FPP MATH 22$: MOV BH,-(SP) MOV BL,-(SP) MOV HORD,BH MOV LORD,BL ;GET REGS... THEN... JSR PC,NORF ;CALL NORMALIZER MOV BH,HORD MOV BL,LORD MOV (SP)+,BL MOV (SP)+,BH 10$: LDCIF HORD,AC0 ;32 BITS TO AC0 LDEXP BE,AC0 ;GET 2-COMP EXPONENT, MAKE EXCESS-200 TST HORD ;IF 0 HI-ORDER #, # IS 0 BNE 1$ TSTB LORD+1 ;IF THERE'S A LOW PART, ALSO OK BNE 1$ CLRF AC0 ;SO CLEAR TO ZERO 1$: RTS PC ; ; XH2S CONVERT HARDWARE TO SOFTWARE FLOATING POINT. ;(REVERSE THE PROCEDURE OF XS2H) XH2S: SETL SETF ; ALWAYS WORK IN LONG INTEGER, SINGLE PREC MODE STF AC0,HORD ;COPY AC0 TO FOCAL FLOATING AC STEXP AC0,BE ;(CUSTOMARY 3-WORD FORM) TSTF AC0 ;CHECK FOR 0.0 CFCC BNE 15$ ;IF SO, RETURN EXACT 0.0 CLR HORD CLR LORD CLR BE ;BY HAND IF NEED BE BR 3$ ;GO GUYS. ;HAVE TO NORMALIZE FOCAL NUMBER HERE. ;NORMALIZATION IS THAT H.O. BIT IS SET ON. ;SIGN IS NOW IN H.O. BIT OF HORD SO BASH OUT EXPONENT AND SAVE THE MESS. 15$: BIC #77600,HORD ;ZOT OUT EXPONENT FROM HORD 2$: MOV HORD,-(SP) ;SAVE SIGN BIC #77777,@SP ;AND ONLY SIGN... BIS #200,HORD ;FILL IN HIDDEN BIT... MOV R0,-(SP) MOV R1,-(SP) MOV LORD,R1 ;USE ASHC FOR FAST 7 BIT LEFT SHIFT MOV HORD,R0 ASHC #7,R0 ;NORMALIZE... MOV R0,HORD MOV R1,LORD MOV (SP)+,R1 ;SAVING REGS ACROSS CALL MOV (SP)+,R0 TST (SP)+ ;SIGN + ?? BEQ 3$ ;YES, FLAC SHOULD BE OK NOW COM LORD COM HORD ADD #1,LORD ;NOT OK, MUST DO 32-BIT NEGATE ADC HORD ;LIKE THIS 3$: RTS PC XFS2H: ;FS2H SOFTWARE TO HARDWARE CONVERT AND STORE ;CALL: ; SET X=FS2H(NUMBER,ADDRESS) ; SETS ADDRESS TO HARDWARE F.P. VALUE JSR PC,XS2H ;CONVERT THE NUMBER FOR AC0 EVALX$ ;GET NEXT ARGUMENT (= ADDRESS) .FPP. FINT ;GET INTEGER FOR ADDRESS STF AC0,@AC ;SAVE THE RESULT XXFSH: ADD #4,AC ;POINT AT NEXT ADDRESS MOV AC,HORD MOV #17,BE CLR LORD ;RETURN AS FUNCTION VALUE RTS PC XFH2S: ;HARDWARE TO SOFTWARE F.P. FUNCTION. ARGUMENT IS ADDRESS. ;RETURNS FOCAL INTERNAL FORM AS FUNCTION VALUE ; SET X=FH2S(ADDR) .FPP. FINT ;GET INTEGER PART OF ADDRESS SETF LDF @AC,AC0 ;GET THE NUMBER JSR PC,XH2S ;CONVERT TO FOCAL FORM IN FLAC RTS PC ; .ENDC .EVEN .PSECT DATA,RW .EVEN ;"INCH" AND "OUTCH" ;USING 'INDEV' AND OUTDEV' FOR 8-BIT I/O. .WORD 0 KBILNK: .WORD 0 .RAD50 /INP/ .BYTE 1,0 .RAD50 /KB/ LIBFLG: .WORD 0,0 KBIFIL: .RAD50 /FCLINPDAT/ .WORD 0,0,0,0 ; ;THE RSX VERSION OF FOCAL WILL HAVE TO MAINTAIN FLAGS OF WHERE ;ITS OUTPUT IS GOING. KEEP ADDRESSES OF THE FDB'S USED IN ;KBOLNK THEREFORE AND NAME THEM KBOFDB AND CSIFDB (TO REMAIN ;MNEMONIC.) SINCE RSX GIVES US A WHOLE LINE AT A TIME, WE'LL ;ALSO HAVE TO PICK THAT APART IN THIS SECTION, ISSUING GCML$ ONLY AT ;THE END OF A LINE, THAT IS, AFTER A C.R. WAS SEEN. CSIFDB: FDBDF$ ;LIBRARY READ FDB FDAT$A R.VAR CSOFDB: FDBDF$ ;GENERATE THE FDB'S HERE FDAT$A R.VAR KBOFDB:: FDBDF$ FDAT$A R.VAR KBIFDB: FDBDF$ FDAT$A R.VAR .GLOBL INPLIN,INPPTR ;GLOBALIZE TO ALLOW PATCHES BY TKB INPLIN: .ASCII /W/<15> ;INITIAL COMMAND TO FOCAL .EVEN .BLKW 54. ;ASSEMBLE UP TO 50 CHARS INPPTR: .WORD 0 ;POINTER TO CHARACTER BEING INPUT OUTLIN: .BLKB TTWIDV .EVEN .BLKW 10. ;SAFETY AREA ENDS OUTPUT BUFFER OUTPTR: .WORD OUTLIN ;SIMILARLY FOR OUTPUT .WORD 0 KBOLNK: .WORD 0 .RAD50 /OUT/ ;LOGICAL NAME .BYTE 1,0 .RAD50 /KB/ .WORD 0,0 KBOFIL: .RAD50 /FCLOUTDAT/ .WORD 0,0,0,0 ;SPARES KBILIN: .WORD 1,2,1 ;READ 1 CHAR AT A TIME, SPECIAL MODE KBIDAT: .WORD 0,0 KBOB$: KBOLIN: .WORD 2,0,2 ;NORMAL MODE KBODAT: .BYTE 0,13 ;VT AFTER EACH WRITE .EVEN .PSECT CODE,RO .EVEN XI33: ;START INPUT/OUTPUT PROCESSING ; DO NOT RE-INIT CONSOLE INPUT. IT SHOULD BE INITED ;AT STARTUP AND NEVER BOTHERED THEREAFTER. ; MOV R0,-(SP) ;DO, HOWEVER, CHECK FOR EOF (CTL-Z) ON INPUT AND EXIT IF IT IS SEEN. ; CHRRR$: TST INPPTR ;IF NULL, NEED A NEW LINE BNE BMP XI34: TST CSILNK ;LIBRARY INPUT UNDERWAY? BEQ XI35 ;NO ;YES, GET RECORD FROM LIBRARY INPUT FDB AND ;FAKE UP TO LOOK LIKE GCML$ TYPE. ;N.B.: ONLY ONE OR THE OTHER MAY BE ACTIVE AT A TIME--NOT BOTH. ;BUFFER GETS PUT INTO GCML$ CONTROL AREA. ;ASSUME L R DATASET IS OPEN IF FLAG IS NON-0. TST LIBFLG ;IF IN LIBRARY MODE, ARE WE READING THE LIBRARY? BEQ XI35 ;NO, USING REGULAR CONSOLE (O K FORCES CONSOLE, O A=>LIB MOV R1,-(SP) ;NEED SOME SCRATCH SPACE MOV #INCMLB+G.CMLD,R1 ;SIZE OF BUFFER<-POINTER ;ASSUME 80. CHAR LINE MAX GET$ #CSIFDB,#INPLIN,#78.,XI50 ;GET DATA IN BR XI36 XI50: TST (SP)+ ;FLUSH JSR CLOSE$ #CSIFDB ;ON ERR (ANY ERR) CLOSE INPUT CLR CSILNK ;AND FLAG CLOSED CLR LIBFLG ;ALSO RESET LIBRARY READIN FLAG (ALLOW PROMPTS) MOV (SP)+,R1 ;PUT BACK R1 BR XI35 ;AND DO A GCML$ XI36: MOV CSIFDB+F.NRBD,(R1)+ ;FILL IN BUFSIZ MOV CSIFDB+F.NRBD+2,@R1 ;AND BUFF ADDR IN GCML$ BLK MOV (SP)+,R1 ;RESTORE R1 BR XI37 ;AND SKIP GCML$ XI35: ;GCML$ TYPE INPUT .IF DF,$$$AST GCML$ #INCMLB,#LIBFLG+2,#1 ;GET INPUT OTHERWISE .IFF GCML$ #INCMLB .ENDC BCC 1$ JMP STOP ;EXIT ON ^Z 1$: XI37: MOV #INCMLB+G.CMLD+2,CHAR ;GET ADDR MOV @CHAR,CHAR MOV CHAR,INPPTR ;SAVE POINTER BMP: MOVB @INPPTR,CHAR ;GET CHARACTER CMPB #32,CHAR ;CTL-Z? BNE 25$ MOVB #40,CHAR ;PUT IN SPACE 25$: CMPB #14,CHAR ;FF? BEQ XI34 ;IGNORE LINE THEN. DEC INCMLB+G.CMLD ;DECREMENT LENGTH INC INPPTR TST INCMLB+G.CMLD BPL 2$ MOVB #15,CHAR ;END LINE WITH CR CLR INPPTR ;FLAG THIS LINE DONE JSR R5,S.RSAV ;SAVE REGS BITB #FD.TTY,INCMLB+F.RCTL ;TEST IF TTY INPUT BEQ 12$ ;IF NOT, DON'T EDITORIALIZE TST LIBFLG ;READING LIBRARY? BNE 12$ ;IF SO, NO EXTRA JUNK PRINT2,CRLF ;EMIT EXTRA CR,LF 12$: JSR R5,S.RRES ;GET REGS BACK 2$: CMPB CHAR,#10 ;BACKSPACE GETS FED TO FOCAL AS CR BNE RRRCH$ ;(SILLY LABELS...) MOVB #15,CHAR RRRCH$: SP=%6 TSTB CHAR ;NULL? BEQ CHRRR$ ;YES. READ NEXT CHARACTER CMPB CHAR,#13 ;VT? (IGNORE) BEQ CHRRR$ ;VT CAN THEN BE USED AS TERMINATOR IN MODIFY BIS #177600,CHAR ;LOOK LIKE 200 BIT WAS ON IN MOVB MOV (SP)+,R0 ;SAVE+RSTR R0 RTS R5 ;RETURN FROM I/O DEVICE ROUTINE. XOUT: JSR R5,S.RSAV ;SAVE REGS FROM FCS MOV CHAR, -(SP) ;SAVE DATA CMP KBOLNK,#KBOFDB ;IS THIS JUST WRITING TO TI:? BEQ 20$ ;YES! DO IT 1 CHARACTER AT A TIME. ;TEST FOR SINGLE-CHARACTER OUTPUT DEVICES ;(I.E., VT:) MOV KBOLNK,R1 ;GET FDB ADDR BIT #R.FIX,F.RTYP(R1) ;SEE IF FIXED SIZE. ;(ONLY FIXED-LENGTH RECS ARE 1 BYTE LONG) BEQ 22$ ;NO? THEN NORMAL OPERATE MOVB @SP,OUTLIN ;YES. SEND OUT. BIC #177600,OUTLIN MOV #OUTLIN,F.NRBD+2(R1) MOV #1,F.NRBD(R1) PUT$ KBOLNK ;SEND CHAR OUT BR 1$ 22$: MOVB @SP,@OUTPTR ;ZOT OUTPUT OUT BICB #200,@OUTPTR ;CLEAR HIGH BIT IF ON INC OUTPTR CMP OUTPTR,#OUTLIN+TTWIDV+4 ;LONGER THAN MAX OUTPUT SIZE? BHIS 2$ ;YES, EMIT THE OUTPUT NOW!! MOVB @SP,R2 BIC #177600,R2 CMPB R2,#15 ;C.R. YET? BNE 1$ ;NO, DON'T WRITE IT YET 2$: MOV OUTPTR,CHAR SUB #OUTLIN,CHAR ;GET LENGTH OF STRING MOV R1,-(SP) MOV KBOLNK,R1 ;GET FDB MOV #OUTLIN,F.NRBD+2(R1) MOV CHAR,F.NRBD(R1) ;SET UP OUTPUT LINE DESCRIPTOR MOV (SP)+,R1 PUT$ KBOLNK ;WRITE IT MOV #OUTLIN,OUTPTR ;REINITIALIZE POINTER BR 1$ 20$: MOVB @SP,KBODAT ;PUT BYTE THERE MOV #KBODAT,KBOFDB+F.NRBD+2 BICB #200,KBODAT ;ENSURE WE WRITE ONLY 7 BIT ASCII MOV #1,KBOFDB+F.NRBD ;SET 1 CHAR OUT PUT$ KBOLNK ;SEND IT TO USER 1$: MOV (SP)+, CHAR ;RESET CHARACTER JSR R5,S.RRES RTS R5 ;RETURN ;THIS KEYBOARD CONTROL IS ASYNCHRONOUS ;KITH: MOV KIN, CHAR ;TEST FOR DATA READY. ; BMI KITH ;WAIT FOR INTERRUPT DONE ; COM KIN ;RESET ; BR XI33X ;RETURN ; ;;KEYBOARD INTERRUPT HANDLER ; ;KINT: MOV @#TKS+2, -(SP) ; CMPB @SP, #203 ;TEST FOR CONTROL-C ; BNE KINT1 ;NO ; COMB CCFLG ;YES, CHANGE DATE ; BNE KINT2 ;TWO? ; ERROR+201+0.+0. ;YES ;KINT1: CLRB CCFLG ;KINT2: TST KIN ;ANY ROOM? ; BMI .+4 ;YES ; ERROR+201+18.+18. ;INPUT BUFFER OVERFLOW. ; MOV (SP)+,KIN ;READ DATA; CLEAR INTERRUPT DONE ; RTI ;CONTINUE ;SQUARE ROOT FUNCTION XSQT: MOV #BE, R5 ;POINT TO FLOATING RESULT (3 WORDS) MOV #FLARG+2,PTR ;POINT TO TEMP STORAGE (2 WORDS) MOV @PTR, -(SP) ;SAVE VALUE FOR NEWTON'S METHOD BPL 1$ ;TEST FOR ERROR+201+17.+17. ;IMAGINARY ROOTS. 1$: BEQ SQUEND ;ARG AND RESULT ARE ZERO. MOV -(PTR), -(SP) ;SAVE OTHER BYTE ASRB @PTR ;MAKE FIRST APPROX. ADCB @PTR ;... MOV #60320, 2(PTR) ;... CLCU: .FPP. FGET+FROM+STACK ;MAKE SUCCESSIVE .FPP. FDV$+IPTR ;APPROXIMATIONS. .FPP. FAD$+IPTR ;... DEC @R5 ;ARE THE EXPONENTS CMPB @PTR, @R5 ;EQUAL? BNE ROOTGO ;NO, TRY AGAIN CMP 2(PTR), HORD ;YES, TEST SOME MORE BNE ROOTGO ;NO CMPB 1(PTR), LORD+1 ;LAST TEST FOR FSQT(3) BHIS SQX ;... ROOTGO: .FPP. FPUT+IPTR ;SAVE NEW ESTIMATE BR CLCU ;TRY AGAIN SQX: TST (SP)+ ;REPAIR STACK SQUEND: TST (SP)+ POPJ ;RETURN ;CLOCK TIME-OF-DAY FUNCTION IN SECONDS SINCE MIDNIGHT ; XFCLK: .MCALL GTIM$S ;GET TIME GTIM$S #CLKT ;GET SYSTEM TO TELL US THE TIME MOV CLKT.H,HORD ;GET HOUR CLR LORD MOV #17,BE .FPP. FNOR .FPP. FML$+IMMED 6,74000 ;60. IN INTERNAL FORM GIVES MINUTES .FPP. FPUT+DIRECT,CLKT ;SAVE MOV CLKT.M,HORD ;GET MINUTE CLR LORD MOV #17,BE .FPP. FNOR .FPP. FAD$+DIRECT,CLKT ;ADD IN MINUTES FROM HOUR .FPP. FML$+IMMED ;MULTIPLY BY 60 AGAIN FOR SECONDS 6,74000 .FPP. FPUT+DIRECT,CLKT ;SAVE FOR ADDING SECONDA MOV CLKT.S,HORD ;SECONDS CLR LORD MOV #17,BE .FPP. FNOR ;NORMALIZE THIS RUBBISH .FPP. FAD$+DIRECT,CLKT ;ADD IN THE REST OF SECONDS. .FPP. FPUT+DIRECT,CLKT ;SAVE TOTAL SECONDS CLR LORD ;NOW GET TICKS/SEC MOV CLKT.S+4,HORD MOV #17,BE ;AND MAKE FOCAL NUMBER OUT OF IT .FPP. FNOR ;NORMALIZE... OPEN+STACK ;SAVE IN STACK .FPP. FPUT+INTO+STACK ; CLR LORD ;NOW GET TICKS MOV CLKT.S+2,HORD MOV #17,BE .FPP. FNOR ;NORMALIZE .FPP. FDV$+FROM+STACK ;TICKS/(TICKS/SEC)= FRACTIONAL SECONDS CLOSE+STACK ;FIX UP STACK .FPP. FAD$+DIRECT,CLKT ;ADD REST OF SECONDS FOR EXACT TIME (!) ;RETURN WITH FLAC=(SECONDS SINCE MIDNIGHT) RTS PC ;RETURN ; ; DATE FUNCTION GIVES DATE FROM SYSTEM (FDAY()) ; XFDATE: ;GIVE DATE AS (((Y*16)+M)*32)+D GTIM$S #CLKT ;GET TIME MOV CLKT,AC ;YEAR ASL AC ;NOW MAKE ROOM FOR MONTH ASL AC ASL AC ASL AC ;4 BITS FOR MONTH MOV CLKT+2,R5 BIC #-20,R5 ;MASK TO 4 BITS BIS R5,AC ;SAVE ASL AC ASL AC ;MAKE ROOM FOR DAY ASL AC ASL AC ASL AC MOV CLKT+4,R5 BIC #-40,R5 BIS R5,AC ;AC IS NOW YYYYYYYMMMMDDDDD MOV AC,HORD ;STORE IT AWAY... CLR LORD ;16 BITS ONLY MOV #17,BE ;INTEGER ;RETURN WITH FLOATING AC=DATE IN FORM STATED RTS PC ;BACK WE GO.... .PSECT DATA,RW CLKT: .WORD 0,0,0 ;Y,M,D CLKT.H: .WORD 0 ;HOUR CLKT.M: .WORD 0 ;MINUTE CLKT.S: .WORD 0 ;SECOND .WORD 0,0 ;TICK, TICKS/SEC .PSECT CODE,RO .EVEN ; *OPERATE*=PROGRAMMABLE I/O COMMAND. ;Z=IOLIST+IOLIST ;IOFIX: ASL AC ;MAKE EVEN ; MOV IOPATCH-Z(AC), PTR ;GET PATCH ADDRESS ; MOV IOGO-Z(AC), @PTR ;STORE THE PATCH ; CMP #PRS, @PTR ;H.S.? ; BNE IOQ ;NO ; BIT #4200, @(PTR)+ ;YES, 'BUSY' OR 'DONE'? ; BNE IOQ ;YES ; INC @-(PTR) ;NO, SET READER ENABLE. IOFIX: MOV AC,-(SP) ;AC(=%1) POINTS TO IOSIST BYTE ON ENTRY SUB #IOLIST,AC ;GET OFFSET ASL AC CMP AC,#20 ;INPUT OR OUTPUT CHANGE?? BGE OU.X ;OUTPUT. BRANCH. CLR INPPTR ;OPERATE INPUT DEV FORCES NEW LINE IN MOV #2,LIBFLG ;SET TO USE LIBRARY CMP AC,#2 ;O K OR O R? IF SO, USE CONSOLE BHI OU.XB ;OTHERWISE READ LIBRARY CLR LIBFLG ;READ CONSOLE IF ACTIVE LIB EVEN THO LIB GOING OU.XB: MOV (SP)+,AC ASL AC BR IOQ OU.X: CMP KBOLNK,CSILKO ;CSI WRITE IN PROGRESS? BNE ..2 ;NO CLR KBOLNK ;YES, ZERO DDB POINTER CURRENT ..2: ; .CLOSE #KBOLNK ; .RLSE #KBOLNK TST KBOFIL+6 ;USE THIS AS FLAG FOR ;ALTERNATE OUTPUT OPEN BEQ ..8 ;IF SO, DON'T CLOSE IT CLOSE$ #OPFDB ;OTHERWISE CLOSE OPERATE FDB ;(ONLY 1 AT A TIME ALLLOWED) CLR KBOFIL+6 ;FLAG IT CLOSED ..8: CMP IODFP(AC),#42420 ;SEE IF THIS IS A RE-OPEN TT: BNE ..9 ;NO, REGULAR F/S OPEN MOV #KBOFDB,KBOLNK ;YES. SET FDB ADDR BR OU.XD ;THEN GO TO NEXT CHARACTER ..9: ;NOW OPEN THE SPECIFIED DATASET USING FDB "OPFDB" ;AS THE ONE TO USE. ; ;FOR DEVICE "VT", SET 1-CHAR-AT-A-TIME OUTPUT, TOO. CMP IODFP(AC),#106240 ;THIS FOR VT:?? ;(VT: AS VT:, THAT IS, O V) BNE ..10 FDAT$R #OPFDB,#R.FIX,,#1 ;1 BYTE RECS BR ..11 ..10: FDAT$R #OPFDB,#R.VAR,,# ;LONG RECORDS .MCALL NMBLK$ ..11: MOV AC,-(SP) ;FIND LUN AND EVENT FLG # HERE ASR AC ;10-20(8) NOW. MAP DOWN A FEW SUB #4,AC ;MAP FROM 4-14 NOW ;USE LUN 1 FOR CSI INPUT(S) ;LUN 2 FOR TT OUTPUT ;LUN 3 FOR CSI OUTPUT ;LUN 4 FOR DELETIONS INC AC ;5-15 MOV R0,-(SP) MOV R2,-(SP) ;USE R2 TO GET DEFAULT NAME MOV AC,R2 ASL R2 MOV OLIST2(R2),R2 ;ADDR OF DEFAULT NAME FDOP$R #OPFDB,AC,,R2,#FO.WRT MOV (SP)+,R2 ;OPERATE IS RESTRICTED TO NONFILE DEVICES IN RSX!! MOV #OPFDB,KBOFIL+6 ;FLAG OPEN OPERATE D/S OPEN$W #OPFDB,AC,,,#OUTLIN,#,INIT2 ;ERROR ==> RESTART MOV #OPFDB,KBOLNK ;FLAG THAT TYPEOUT GOES HERE MOV (SP)+,R0 MOV (SP)+,AC ;REPLACE AC AND R0 ;THANK HEAVEN, R0 IS A SCRATCH REGISTER. F11ACP CHANGES IT. OU.XD: MOV (SP)+,AC ASL AC IOQ: GETC$ ;LOOK AT NEXT TEXT CHAR. PROGIO: SPNOR$ ;GOTO NEXT LETTER SORTC$ IOLIST,IOFIX ;TEST JMP PROC ;CONTINUE THE LINE. .EVEN .PSECT DATA,RW .EVEN OPFDB: FDBDF$ FDAT$A R.VAR IOLIST=. .ASCII "RKABCDEF" ;INPUT DATASETS .ASCII "PTLVWXYZG" ;OUTPUT DATASETS .BYTE 0 .EVEN FCLLIT: .RAD50 /FCL/ OLIST2: .WORD GGG1,GGG1,GGG1,GGG1,GGG1 ;GBG DEV .WORD SSS1,TTT1,LLL1,VVV1,VVV1 .WORD TTT1,GGG1,GDGD,SGGG1,GGG1 .WORD GGG1 ;SPARE LLL1: NMBLK$ LINPRT,FCL,0,LP,0 ;LP: SGGG1: NMBLK$ FCLDTZ,DAT,0,SY,0 ;SY:FCLDTZ.DAT GGG1: NMBLK$ GARBAGE,FCL,0,GB,0 ;GB: D/S GDGD: NMBLK$ GOULDDT,FCL,0,TT,1 ;TT1: SSS1: NMBLK$ FOCALDAT,FCL,0,SY,0 ;SYSTEM DEV D/S (?) TTT1: NMBLK$ FOOBAR,FCL,0,TI,0 ;TI: (SHOULD BE UNNECC) VVV1: NMBLK$ FOCALSCP,FCL,0,SY,0 ;VT: STUFF IOLGD: .RAD50 /LBIKBD1 2 3 4 5 6 / .RAD50 /LBOTTYLPTVT 7 8 9 10 GB / ;INPUT,THEN OUTPUT IODFP: .RAD50 /SY KB SY SY SY SY SY SY / .RAD50 /SY KB LP VT SY SY SY SY GB /;PHYS DEVICES. IOGO=. PRS TKS PPS TPS LPS IOPATCH=. INDEV INDEV OUTDEV OUTDEV OUTDEV ;***... .IF NDF,XUSING .PSECT CODE,RO .EVEN UHOWT: .WORD FO.WRT,FO.UPD,0,0 .WORD FO.RD,FO.RD,FO.WRT,FO.WRT,0 UHOWA: .WORD FA.DLK,FA.DLK,0,0,FA.RWD,FA.RWD,0,0,0 URACC: .WORD FD.RAN,FD.RAN ;.RECRD D/S .WORD 0,0 ;INAPPLICABLE TO .TRAN DATASETS THAT USE QIO .WORD 0,0,0,0 ;1,2,3,4 D/S ARE SEQUENTIAL ONLY .WORD 0 ;TABLES FOR OPENING FILES .MCALL OPEN$ ; ;USING DATASET LETTER, TAKE ACTIONS INDIVIDUALLY. BINARY I/O. ;FOR RSX VERSION, THE .SPEC FUNCTION HANDLER WILL MERELY ;PERMIT A USER TO SET UP A DPB OF HIS OWN AND CALL IT. FOCAL ;WILL PUSH THE ADDRESS GIVEN AND ISSUE THE EMT 377, BUT WILL ONLY ;CHECK THAT THE ADDRESS IS EVEN. IT WILL BE UP TO THE USER TO ;AVOID CLOBBERING HIMSELF. SINCE FOCAL WILL RUN AS A NON-PRIVILEGED ;TASK (EVEN WITH INTERRUPTS), THE SYSTEM WILL HAVE SOME PROTECTION ;AGAINST WANTON SCREWUPS OF THE FILE STRUCTURES. USFCL: .ASCII /RWDICTLS/<0> .EVEN USFAL: .WORD USRED ;READ .WORD USWRYT ;WRITE .WORD USDFN ;DEFINE .WORD USINI ;INIT .WORD USCLS ;CLOSE .WORD USTST ;TEST .WORD USWAT ;LOOP VIA .WAIT REQ .WORD USSPEC ;SPECIAL (USER MUST SETUP HIS OWN .SPEC BLOCK) .WORD 0 USING: GETC$ SPNOR$ ;SKIP SPACE AFTER "USING" SORTC$ UDSCHR,UGOTDV USGER: ERROR+201+30.+30. ;ERROR IN USING SYNTAX UGOTDV: SUB #UDSCHR,AC ;AC POINTS TO BYTE OF DEVICE CODE ASL AC ;NOW HAS OFFSET TO DATASET TYPE MOV AC,-(SP) ;SAVE ON STACK GETC$ SPNOR$ ;SKIP TO NEXT NONSPACE CHARACTER. SORTJ$ USFCL,USFAL BR USGER ;ERROR IF NOT A VALID FUNCTION .PSECT DATA,RW .EVEN USDFN: ;USING D "DEV:[UIC]FILE.EXT;VERS" ;DEFINE DATASET (PRIOR TO USE!) GETC$ BPL USDFN ;AWAIT SPACE SPNOR$ CMPB CHAR,#42 ;" SIGN? BNE USGERJ ;NO, ERROR! CLR CBDAT-2 ;BUFFER HDR+4 CLR CBDAT-6 ;BUFFER HDR MOV #CBDAT,R5 ;BUFFER DATA POINTER UDLP1: GETC$ MOV CHAR,TEMP BPL UDLP2 ;KEEP GOING, TEST " BIC #177600,TEMP MOVB TERMS(TEMP),TEMP ;GET BASK ASCII UDLP2: CMPB TEMP,#42 ;SECOND " NOW? BEQ UDDDUN ;YES, INSERT CR AND LF AND GO MOVB TEMP,(R5)+ INC CBDAT-2 INC CBDAT-6 ;COUNT CHARACTERS CMPB TEMP,#15 ;CR IS ALSO END BLE USGERJ ;ERROR CONDITION CMP R5,#CBDAT+68. BHI USGERJ ;ALSO ERROR IF SPECS TOO LONG BR UDLP1 ;ELSE GET NEXT CHAR UDDDUN:; MOVB #13,(R5)+ ; INC CSUDT-6 ; INC CSUDT-2 ;COUNT VT. VT FOR CSI HANDLER. ;RSX CSI HANDLING CODE DISLIKES TERMINATORS ;NOW GO THRU TO CSI1 CALL .MCALL CSI$1 MOV R5,-(SP) MOV 2(SP),R5 ;OFFSET TO DATASET MOV UDSCSI(R5),R5 ;POINT NOW AT CSIBLK ;R0 IS ABOUT TO BE ZAPPED SO DON'T SAVE IT! (TEMP=%0) MOV @R5,R5 ;OUR CSIBLK POINTS TO RSX ONE CSI$1 R5,#CBDAT,CBUFHD+4 ;DO CSI THING BCS USGERJ ;COMPLAIN IF HIS DEF. WAS BAD MOV (SP)+,R5 ;REPLACE R5 AND STACK UDDLL: GETC$ BPL UDDLL ;NOW FLUSH TILL TERMINATOR MOV (SP)+,TEMP ;OFFSET TO DATASET MOV UDSCSI(TEMP),TEMP ;GET CSIBLK ADDR MOV TEMP,CSICAL ;NOW CALL JSR R5,CSISET CSICAL: .WORD 0 ;CSI INTERFACE IN LIBRARY ROUTINES JMP USFINX ; USGERJ: ERROR+201+30.+30. .PSECT CODE,RO .EVEN ; ;LINKBLKS AND FILEBLKS SHOULD BE SET UP NOW ; USFINX: TSTB CHAR ;NOW FLUSH CHAR OUT TILL TERMINATOR BMI USPRJ GETC$ BR USFINX USPRJ: JMP PROC ;CONTINUE LINE ; USINR SET UP READ/WRITE STUFF FOR RANDOM ACCESS DATASETS. ; THESE NEED AN EXTRA PARAMETER, RECORD LENGTH, AT INIT TIME ; TO DO PROPER OPENS FOR FCS. FORMAT OF THAT INIT IS THUS ; U Q I,200 ;TO INIT A 200-BYTE-RECORD FILE ON D/S #Q. USINR: GETC$ ;SKIP COMMA IN "U Q I,NNN" EVALX$ ;FIND RECORD SIZE .FPP. FINT ;MAKE INTEGER IN 'AC' MOV AC,-(SP) ;SAVE IT... BNE 12$ ERROR+201+30.+30. ;IF 0 LENGTH ERROR, TELL HIM 12$: JSR R5,S.RSAV ;MAKE REGS AVAILABLE... ;OPEN FILE, SET UP FDB FOR RANDOM ACCESS. ; STACK: ; OFFSET TO DATASET DATA BLOCK ; REC SIZE BYTES ; OLD R5 ; OLD R4 ; OLD R3 ; OLD R2 ; OLD R1 ; OLD R0 MOV 16(SP),R0 ;GET OFFSET TO DATA POINTERS MOV UDSCSI(R0),R0 ;R0 POINTS TO ADDR OF CSIBLK MOV 2(R0),R2 ;R2 POINTS TO FDB MOV 14(SP),R1 ;GET BLOCK SIZE TOO JSR R5,S.RSAV ;SAVE THISS STUFF MOV R2,R0 .MCALL FDAT$R,FDRC$R,FDOP$R FDAT$R R0,#R.FIX,,R1,#-1,#-1 ;SET UP BLK SIZE, MIN. ALLOC. SIZE. FDRC$R R0,#FD.RAN ;SET UP FOR RANDOM ACCESS OF Q,R D/S. MOV 16(SP),R4 ;GET OLD OFFSET TO BLOCKS ASR R4 ;CHANGE TO BYTE INDEX ADD #14.,R4 ;GET LUN NUMBER TO USE... TST 16(SP) ;IS D/S THE Q D/S? BEQ 1$ ;YES, WRITE NEW FILE FDOP$R R0,R4,,#DFNBK,#FO.UPD,#FA.DLK ;REQUIRE FILE TO PRE-EXIST BR 2$ 1$: FDOP$R R0,R4,,#DFNBK,#FO.WRT,#FA.DLK ;NEW FILE 2$: JSR R5,S.RRES ;RESTORE POINTERS MOV R2,2(SP) ;SET RETURN R1=FDB ADDR MOV R0,@SP ;ALSO CSIBLK ADDR SETUP MOV R2,12(SP) ;SET UP R5 RETURN TOO JSR R5,S.RRES TST (SP)+ ;POP STACK BACK JSR R5,S.RSAV ;SAVE REGS AGAIN AS NEEDED HERE MOV 14(SP),R4 ;GET OFFSET TO DATASETS MOV R4,R3 ;SAVE WORD OFFSET ASR R4 ADD #14.,R4 ;MAKE LUN OF IT JMP USIPRS ;GO PARSE THE DATASET NOW. ; ;INIT DATASET. IMPLIES .OPEN FOR ALL BUT .TRAN DATASETS, AND; ;CHECKS THAT .TRAN DATASET IS NONFILE DEVICE (VIA .STAT) ;NOTE-- U R D "DATASET" MUST BE CALLED FIRST TO SETUP DATASET ;(UNLESS MAGTAPE DEFAULT FOR .TRAN DATASETS S AND T IS OK) USINI: MOV (SP),R0 ;GET OFFSET MOV UDSCSI(R0),R0 ;POINT TO CSIBLK MOV 2(R0),R1 ;R0,R1,R5 MAY BE USED ;DO APPROPRIATE OPEN$X OPERATION FOR FILESTRUCTURED ;DATASETS. INIT IS A NO-OP FOR DATASETS S AND T ;SINCE THESE JUST DO QIO$ AND NO MORE. CMP R0,#UCSIS ;TEST FOR .TRAN DATASETS BLO USINR ;NOT TRAN TYPE CMP R0,#UCSIT BHI 1$ ;NOT TRAN TYPE JSR R5,S.RSAV ;JUST ASSIGN THE LUN TO THE DEVICE .MCALL ALUN$S ;PRESUME HE JUST ENTERED DATASET NAME. ;NOTE--IN RSX FOCAL, INITIALIZE CALL MUST IMMEDIATELY ;FOLLOW DEFINE CALL. RSX CSI BLKS ARE TOO LONG TO KEEP ;MANY OF THEM AROUND AT A TIME. MOV @R0,R5 ;RSX CSIBLK ADDR MOV C.DEVD+2(R5),R4 ;DEVICE NAME ADDR BEQ 25$ ;IF NONE, NO ASSIGN ;I.E., DEFAULT IS NO I/O IF NO DEFINITION TSTB @R4 ;CHECK THERE IS A NAME BEQ 25$ MOVB 2(R4),R3 ;GET UNIT # BYTE SUB #60,R3 CMP R3,#7 ;CHECK THAT RANGE IS 0-7 BLOS 24$ ;DEFAULT NUMBER TO 0 THO CLR R3 24$: MOV R0,R2 ;GET LUN NOW SUB #UCSIQ,R2 ;FROM CSIBLK ADDR ASR R2 ASR R2 ASR R2 ;NOW 2-3 ADD #14.,R2 ;NOW 14-15. ALUN$S R2,R4,R3 ;SET UP THE ASSIGNMENT 25$: ;AND THAT'S ALL JSR R5,S.RRES ;FALL THRU IF .TRAN TYPE DATASET TST (SP)+ ;FIX UP STACK JMP USFINX ;IF .TRAN-TYPE, WE'RE DONE THIS... 1$: MOV 2(R0),R5 ;FDB ADDR ;OUR CSI BLK POINTS TO RSX CSIBLK, FDB, IO STAT BLK, AND CTRL BLK ;WHERE THE CTRL BLK VARIES WITH D/S TYPE. FOR D/S'S S AND T, ; ;CTRL BLK IS A DPB FOR A QIO OPERATION. FOR OTHERS IT IS ; ;A SHORT BLOCK THAT WAS USED UNDER DOS AND MAY BE PARTLY ; ;USED HERE. JSR R5,S.RSAV ;SAVE R5-R0 MOV 14(SP),R4 ;GET OLD "@SP" OFFSET MOV R4,R3 ;SAVE WORD OFFSET ASR R4 ;MAP TO BYTE OFFSET ;(THIS S.RSAV PRESERVES R5 ACROSS CALL) ADD #14.,R4 ;R4 IS LUN OF DATASET NOW .MCALL FDOP$R MOV R0,-(SP) MOV R5,R0 FDOP$R R0,R4,,#DFNBK,UHOWT(R3),UHOWA(R3) MOV (SP)+,R0 USIPRS: JSR R5,S.RSAV MOV R5,R1 ADD #F.FNB,R1 ;FNB ADDR MOV @R0,R2 ;CSIBLK ADD #C.DSDS,R2 MOV #DFNBK,R3 ;DEFAULT BLK MOV R2,4(SP) ;ARRANGE MAGIC RETURN R2 TO ;BE DATASET POINTER AFTER RRES MOV R5,R0 JSR PC,.PARSE ;SET UP NAME SPECS JSR R5,S.RRES ;RESTORE OUR REGS OPEN$ R5,UHOWT(R3),R4,R2,#DFNBK,URACC(R3),,,USGER ;NOTE RECORD BUF SET UP AT ASSEMBLY TIME ;ERROR RETURN CALLS ERROR 30 IF OPEN FAILS JSR R5,S.RRES ;RESTORE SAVED REGS TST (SP)+ ;AND POP OFFSET OFF STACK JMP USFINX ;THAT'S ALL ; ;CLOSE DATASET. PERFORMS .CLOSE WHERE APPROPRIATE, AND .RLSE IN ALL ;CASES ON SPECIFIED DATASET. USCLS: MOV (SP)+,R0 ;DATASET POINTER CMP R0,#2 ;D/S Q OR R? BLE 1$ ;YES. CMP R0,#10 ;1-4? BGE 1$ ;YES ;TRAN-TYPE DATASET. THESE ARE NEVER OPENED AND MUST NOT BE CLOSED BR USCLSX ;SO SKIP CLOSE 1$: MOV UDSCSI(R0),R0 ;GET CSIBLK ADDR MOV 2(R0),R1 CLOSE$ R1 ;JUST ISSUE THE CLOSE USCLSX: JMP USFINX ;FLUSH ANY OTHER GARBAGE TILL TERMINATOR ; ;TEST DATASET. FORM IS U D T,VARIABLE ;VARIABLE RETURNS WITH 1 IF FREE, -1 IF BUSY USTST: MOV (SP)+,R0 ;DATASET MOV R0,R5 ;SAVE OFFSET MOV UDSCSI(R0),R0 MOV #170707,-(SP) ;MARK STACK POSITION FOR LATER MOV 4(R0),R1 MOV #-1,-(SP) ;ASSUME BUSY ;TEST STATUS OF I/O BY RETURNING I/O STATUS BLOCK OF DATASET ;WHICH IS POINTED TO BY THE CSIBLK. ; ;FOR TRAN-TYPE DATASETS, A VALUE OF -1 WILL IMPLY I/O STILL ;IN PROGRESS. OTHER VALUES WILL JUST BE THE I/O STATUS. ; ; SINCE THE I/O STATUS BLOCK IS 2 WORDS LONG, 2 ARGS WILL BE ;ALLOWED AND FILLED IN WITH WORDS 0 AND 1 IF BOTH ARE THERE. ;THE -1 FOR TRAN-TYPES GOES INTO WORD 0. CMP R5,#4 ;D/S S? BLT 12$ CMP R5,#6 ;D/S T? BGT 12$ ;NO ;TRAN-TYPE. ;GET EVENT FLAG NOW. ASR R5 ;MAP TO GET LUN ; ADD #14.,R5 ;LUN 16. OR 17. ; .MCALL RDEF$S ;EVENT FLAGS ARE 14. AND 15. TOO MOV R0,-(SP) ; RDEF$S R5 RDAF$S #EVTFGS ;OK, IS THE FLAG ON? MOV (SP)+,R0 ;DARN RSX USING R0 ALL THE TIME! ; TST @#$DSW ;IF 0, I/O STILL GOING CMP R5,#2 ;R5=2 OR 3 FOR EF 16 OR 17= BITS 0 OR 1 OF ;EVTFGS+2 WORD NOW. FIND OUT WHICH BIT TO TEST. BEQ 47$ ;BIT 0 BIT #1,EVTFGS+2 ;CHECK E.F. 17 BR 28$ 47$: BIT #100000,EVTFGS ;CHECK E.F. 16 28$: BNE 14$ ;SO SKIP AROUND FILE-STRUCTURED RTNS MOV @R1,@SP ;GIVE HIM THE REAL I/O STATUS BLK WD 1 BR 14$ ;AND SKIP THE FOLLOWING: 12$: ;FILE-STRUCTURED I/O. ;THIS I/O IS ALL SYNCHRONOUS SINCE (THANKS, DEC!) (???) PUT$ AND ;GET$ DON'T RETURN CONTROL--EVEN WHERE THE DEVICE HAS TO MOVE. ;THEREFORE I/O RETURNS NEED ONLY CHECK THE I/O STATUS BLK ;(IF IT EVER OCCURS TO DEC TO MAKE THIS I/O POTENTIALLY ;ASYNCHRONOUS AS IT IS IN DOS, WE MAY BE ABLE TO IMPROVE THIS.) MOV @R1,@SP ;STASH IT AWAY NICELY... 14$: ;NOW GET WORD 2 OF I/O STATUS BLK MOV @SP,-(SP) ;MOVE WORD 1 DOWN MOV 2(R1),2(SP) ;SHOVE WORD 2 ONTO STACK TO DEPROCESS 1$: SPNOR$ ;PASS SPACE(S) 3$: GETC$ CMPB CHAR,#CR ;END OF LINE TOO SOON? BNE 15$ ;NO--GUESS WE CAN TRY MORE ERROR+201+41.+41. ;YES. TELL THIS IDIOT WHERE HE CAN GO 15$: CMPB CHAR,#214 ;COMMA? BEQ 3$ ;SKIP IT! JSR PC,GETARG ;FIND ARG CMPB -3(PTR),#PRCNT ;SEE IF INTEGER TYPE BNE 4$ MOV -2(PTR),R5 ;SUBSCRIPT CMP R5,@PTR ;TOO BIG? BLOS 5$ ;NO,OK JMP FINERR 5$: ASL R5 ;BYTE OFFSET ADD #2,PTR ADD R5,PTR MOV (SP)+,@PTR ;PUT RESULT IN BR 27$ ;FLUSH TILL TERMINATOR 4$: MOV @SP,HORD CLR LORD ;SAVE NUMBER FOR USER MOV #17,BE .FPP. FPUT+IPTR ;SAVE WHERE POINTER POINTS TST (SP)+ ;GET OUT FAST 27$: CMP @SP,#170707 ;THIS OUR END MARKER BNE 3$ ;NO, PROCESS ANOTHER VALUE TST (SP)+ ;YES, REMOVE THE RUBBISH BR USCLSX ;FLUSH JUNK ; ;USWAT--WAIT UNTIL DATASET'S I/O IS DONE. DONE VIA DOS .WAIT USWAT: MOV (SP)+,R0 MOV R0,R5 ;SAVE OFFSET ASR R5 MOV UDSCSI(R0),R0 CMP R0,#UCSIS BLO 1$ ;NON TRAN-TYPES DON'T NEED WAIT CMP R0,#UCSIT BHI 1$ ;SO DO NOTHING FOR THOSE ADD #14.,R5 ;MAP TO FLAG NUMBER ;14. OR 15., NOTE BOTH IN GROUP 01 .MCALL WTSE$S .MCALL MRKT$S,CMKT$S ;HAVE A SAFETY TIME-OUT 15 SEC MRKT$S R5,#15.,#2 WTSE$S R5 ;WAIT FOR SOMETHING TO HAPPEN CMKT$S R5 ;CANCEL WAIT IF STILL OUTSTANDING 1$: ;THAT'S IT... ;THE MARK-TIME IS NEEDED SINCE THE USER MAY NOT HAVE ACTUALLY ;INITIATED ANY I/O ACTIVITY AND FOCAL SHOULD NOT WAIT FOREVER ;FOR INTERVENTION. BR USCLSX ; ;USRED--READ FROM DATASET. FORMAT DEPENDS ON TYPE OF DATASET. ; ;FOR ALL BUT .RECRD DATASETS, FORMAT IS: ;USING D R ADDR,WC ;TO READ WC WORDS INTO ADDR (UNFORMATTED BIN) ; ;FOR .RECRD DATASETS, FORMAT IS ;USING R R ADDR,WC,RECSIZ,RECNO ;WHERE RECSIZ IS SIZE OF RECORD, ; AND RECNO IS RECORD NUMBER ; ;USWRYT FORMATS WILL BE ANALOGOUS. USRED: GETC$ ;SKIP COMMA OR SPACE EVALX$ .FPP. FINT ;GET ADDR ; CMP AC,PC ;BADLY ILLEGAL? ; BHI 1$ ;NO, HE PROBABLY KNOWS WHAT HE'S DOING BR 1$ 3$: ERROR+201+31.+31. ;WOW!! 1$: MOV AC,-(SP) EVALX$ .FPP. FINT ;GET WC MOV AC,-(SP) BLE 3$ ;NEG OR 0 WC? ERROR! MOV 4(SP),R0 ;GET D/S INDEX JMP @USRTBL(R0) ;GO TO SERVICE IT USRTBL: RCRD,RCRD,TRN,TRN,REA,REA,REDERU,REDERU REDERU: ERROR+201+30.+30. ;ATTEMPT TO READ .WRITE DATASET REA: MOV UDSCSI(R0),R0 ;LOCATE CSIBLK MOV 2(R0),R1 ;FDB .MCALL PUT$,GET$,PUT$R,GET$R ASL @SP ;WC TO BC MOV 2(SP),R5 ;ADDR BIC #1,R5 ;EVENIZE ADD #2,R5 ;SAVE CELL FOR ACTUAL WORD COUNT AT START MOV R1,R0 MOV R0,-(SP) ;SAVE FDB ADDR MOV @SP,R1 GET$ R0,R5,R1 ;READ RECORD MOV (SP)+,R0 ;FDB ADDR ADD #G.CMLD,R0 ;OFFSET TO RECORD LENGTH MOV @R0,-2(R5) ;SAVE IN VECTOR CELL WE RESERVED ABOVE ;NOTE THAT READS MUST RESERVE A CELL TO PUT RECSIZE IN AT START NOW. ;DATA BEGINS 1 WORD (2 BYTES) LATER!! ADD #6,SP ;FLUSH D/S INDEX,BC,ADDR JMP USCLSX TRN: MOV UDSCSI(R0),R0 ;FIND TRAN BLOCK MOV 6(R0),R1 ;TRNBLK ADDR MOV #IO.RVB,2(R1) ;SET FUNCTION ASL @SP ;GET BYTE COUNT MOV @SP,16(R1) MOV 2(SP),14(R1) ;SET ADDR MOV R1,-(SP) EMT 377 ;QIO$S ADD #6,SP ;RESTORE STACK AND SCRAM UTRCX: JMP USFINX ; ;RECORD READ MODE RCRD: EVALX$ ;GET RECSIZE .FPP. FINT MOV AC,-(SP) EVALX$ .FPP. FINT MOV AC,-(SP) ;AND RECNO ; ;STACK NOW HAS ;DATASET OFFSET ;ADDR ;WC ;RECORD SIZE ;RECORD NUMBER (16 BITS ONLY) ; MOV 10(SP),R0 ;DATASET POINTER MOV UDSCSI(R0),R0 MOV 2(R0),R1 ;FDB ADDR MOV R1,R0 ;FDB IN STD REG JSR R5,S.RSAV MOV 14(SP),R5 ;REC # 16 BITS ONLY MOV 16(SP),R4 ;REC SIZE ;MAKE SURE THE FDB SAYS FIXED-LENGTH RECS AND OUR SIZE ;BY SETTING IT BY HAND MOVB #R.FIX,F.RTYP(R0) ;FIXED-LENGTH MOV R4,F.RSIZ(R0) ;OF USER-SPECIFIED SIZE MOV 20(SP),R3 ;WC ASL R3 ;MAKE IT A BYTE COUNT MOV 22(SP),R2 ;ADDR GET$R R0,R2,R3,R5,#0,USGER ;READ THE RECORD. ;(IGNORE RECORD SIZE PARAMETER) JSR R5,S.RRES ADD #12,SP ;FLUSH ARGS BR UTRCX ;THEN GO ; ; USWRYT: GETC$ ;SKIP ANY COMMAS EVALX$ ;GET ADDR .FPP. FINT MOV AC,-(SP) ; CMP AC,PC ;BADLY ILLEGAL ADDR? ; BHI 1$ ;NO, NOT OBVIOUSLY BR 1$ 3$: ERROR+201+31.+31. ;YES, CALL ERROR 1$: EVALX$ .FPP. FINT MOV AC,-(SP) BLE 3$ ;NEG OR 0 WORDCOUNT--ILLEGAL MOV 4(SP),R0 JMP @USWTBL(R0) USWTBL: RCRW,RCRW,TRW,TRW,REDERU,REDERU,WRY,WRY WRY: MOV UDSCSI(R0),R0 MOV 2(R0),R1; ;FDB ASL @SP MOV 2(SP),R5 ;ADDR MOV R1,R0 MOV @SP,R1 PUT$ R0,R5,R1 ;WRITE RECORD ADD #6,SP WRYXX: JMP USFINX TRW: MOV UDSCSI(R0),R0 MOV 6(R0),R1 ;TRNBLK MOV #IO.WVB,2(R1) ;SET WRITE (VIRTUAL) FUNCT. ASL @SP ;BYTE COUNT MAGICALLY FROM WORD COUNT MOV @SP,16(R1) ;PUT INTO QIO BLK PARAM. MOV 2(SP),14(R1) ;SET ADDR MOV R1,-(SP) EMT 377 ;START THE QIO$ ADD #6,SP BR WRYXX RCRW: EVALX$ ;GET RECSIZE .FPP. FINT MOV AC,-(SP) EVALX$ ;AND REC # .FPP. FINT MOV AC,-(SP) ;PUT IN OUR RECORD SIZE BY HAND. IF USER VARIES SIZE, TOO BAD! MOV 10(SP),R0 MOV UDSCSI(R0),R0 MOV 2(R0),R1 ;FDB ADDR MOV R1,R0 JSR R5,S.RSAV MOV 14(SP),R5 ;REC # (16 BITS ONLY) MOVB #R.FIX,F.RTYP(R0) ;SET FIXED-LENGTH RECS MOV 16(SP),F.RSIZ(R0) ;SET OUR SIZE TOO MOV 20(SP),R3 ;WC ASL R3 ;(BECOMES BYTE COUNT) MOV 22(SP),R2 ;ADDR (OUR SPACE, GUYS.) PUT$R R0,R2,R3,R5,#0,USGER ;OUT WITH IT. JSR R5,S.RRES ADD #12,SP BR WRYXX ;DONE! ;SPECIAL-- FORMAT OF CALL ; ;USING S,ADDR.SPCBLK ;WHERE "ADDR.SPCBLK" ; IS THE ADDRESS OF A .SPEC BLOCK THE USER MUST SET UP HIMSELF. ; NOTE NO CHECK ON ITS LEGALITY IS MADE. USSPEC: GETC$ ;SKIP COMMA EVALX$ ;GET ADDRESS ARGUMENT .FPP. FINT ;INTEGER NUMBER TST AC ;ZERO IS ILLEGAL BEQ 3$ BIT #1,AC ;CHECK FOR EVEN ADDRESS BEQ 1$ ;BUT NO OTHER CHECKS 3$: ERROR+201+30.+30. ;NO, USER SCREWUP--BAD CALL 1$: MOV (SP)+,R0 ;GET DATASET INDEX MOV UDSCSI(R0),R0 ;CSIBLK ADDR ;IGNORE DATASET AND ISSUE THE CALL POINTED TO BY R1 MOV R1,-(SP) EMT 377 ;(HOPE THE USER KNOWS WHAT HE'S DOING!) JMP USFINX ;THEN CLEAN LINE + GO .ENDC ;XUSING*** ; .EVEN .PSECT CODE,RO .EVEN ; EXPONENTIAL FUNCTION ; XFEXP: OPEN+STACK ;INITIALIZE STACK TO STORE & .FPP. FPUT+INTO+STACK ;SAVE ARG ON IT .FPP. FML$+FROM+STACK ;SQUARE IT CMP BE,#-8. ;SEE IF EXPONENT IS LESS THAN -8. BGE $14.15 .FPP. FGET+FROM+STACK ;RESTORE ARG TO CELL BR $14.2 $14.15: .FPP. FGET+FROM+STACK DEC BE ;DIVIDE BY 2 BY DECREASING EXPONENT .FPP. FPUT+INTO+STACK ;SAVE ON STACK JSR PC,XFEXP ;RECURSIVE CALL .FPP. FPUT+INTO+STACK ;PUT & INTO STACK .FPP. FML$+FROM+STACK ;SQUARE CMP (SP)+,(SP)+ ;RETURN AFTER CLEARONG STACK RTS PC $14.2: .FPP. FPUT+INTO+STACK ;SAVE OLD VALUE ;1+(X/2(1+(X/3(1+X/4(1+X/5(1+X/6)))))) .FPP. FDV$+IMMED ;DIVIDE BY 6 3,60000 .FPP. FAD$+DIRECT,FLTONE ;ADD 1.0 .FPP. FDV$+IMMED ;/5 3,50000 .FPP. FML$+FROM+STACK ;*X .FPP. FAD$+DIRECT,FLTONE DEC BE ;DIVIDE BY 4 FAST DEC BE ;BY DECREMENTING EXP. TWICE .FPP. FML$+FROM+STACK .FPP. FAD$+DIRECT,FLTONE .FPP. FDV$+IMMED 2,60000 .FPP. FML$+FROM+STACK .FPP. FAD$+DIRECT,FLTONE DEC BE .FPP. FML$+FROM+STACK .FPP. FAD$+DIRECT,FLTONE ; .FPP. FML$+FROM+STACK ;FINAL STEP .FPP. FAD$+DIRECT,FLTONE ;IS THIS... CMP (SP)+,(SP)+ RTS PC ; ; ;LOGARITHM ; XFLOG: OPEN+STACK ;SAVE STACK STORE .FPP. FPUT+INTO+STACK ;PUT ARG THERE TST HORD ;NEGATIVE? BGT $15.11 ;NO,GO ON ERROR+201+22.+22. ;YES. CAN'T HAPPEN! $15.11: .FPP. FSB$+IMMED ;SUBTRACT CONSTANT 2.04 130002,40507 ;2.04 .FPP. FML$+FROM+STACK ;X**2 .FPP. FAD$+DIRECT,FLTONE ;ADD 1 TST HORD ;CHECK SIGN (HOPEFULLY REENTRANT!) BPL $15.15 .FPP. FGET+FROM+STACK ;NEGATIVE, LOAD ARG AGAIN BR $15.2 $15.15: .FPP. FGET+FROM+STACK .FPP. FPUT+DIRECT,FLARG ;XSQT EXPECTS RESULT IN FLARG JSR PC,XSQT JSR PC,XFLOG ;RECURSIVE CALL NOW... INC BE ;MULT. RESULT BY 2 CMP (SP)+,(SP)+ RTS PC $15.2: OPEN+STACK ;MAKE REENTRANT .FPP. FPUT+INTO+STACK .FPP. FAD$+DIRECT,FLTONE ;X+1 MOV SP,R2 ADD #4,R2 .FPP. FPUT+IPTR ;SAVE ON LOWER STACK .FPP. FGET+FROM+STACK ;GET X .FPP. FSB$+DIRECT,FLTONE CLOSE+STACK .FPP. FDV$+FROM+STACK .FPP. FPUT+INTO+STACK ;PUT ONTO STACK AGAIN ;X(1+X^2((1/3)+X^2((1/5)+X^2/7))) .FPP. FML$+FROM+STACK .FPP. FDV$+IMMED 3,70000 ;DIVIDE BY 7 .FPP. FAD$+IMMED ;ADD APPROXIMATE CONSTANT OF 1/5 64376,63146 ;0.2 .FPP. FML$+FROM+STACK ;*X .FPP. FML$+FROM+STACK ;*X^2 .FPP. FAD$+IMMED ;ADD 1/3 52777,52525 ;1/3 .FPP. FML$+FROM+STACK .FPP. FML$+FROM+STACK ;MULTIPLY JUNK .FPP. FAD$+DIRECT,FLTONE ;ADD 1 .FPP. FML$+FROM+STACK ;MULT. BY X FINALLY INC BE ;THEN BY 2 CMP (SP)+,(SP)+ ;FIX STACK RTS PC ; ; ; ;ARC-TANGENT ; XFATN: JSR PC,XFATN2 ;CALL REAL ARCTAN .FPP. FML$+DIRECT,AMPNIN ;MULTIPLY OUTPUT RTS PC ;FINAL RETURN XFATN2: OPEN+STACK ;SETUP STACK SPACE .FPP. FPUT+INTO+STACK .FPP. FML$+FROM+STACK CMP SP,#100 ;RUNNING OUT OF STACK TO RECURSE? BLOS $13.14 ;YES, DON'T CRASH FOCAL--GET OUT. CMP BE,#-8. ;VERY SMALL? BGT $13.15 ;NO,GO ON $13.14: .FPP. FGET+FROM+STACK BR $13.2 $13.15: .FPP. FGET+FROM+STACK ;RESTORE VALUE .FPP. FML$+FROM+STACK ;SQUARE IT .FPP. FAD$+DIRECT,FLTONE ;ADD 1 .FPP. FPUT+DIRECT,FLARG ;SETUP FOR XSQT JSR PC,XSQT ;GET SQRT .FPP. FAD$+DIRECT,FLTONE ;ADD 1 TO IT OPEN+STACK .FPP. FPUT+INTO+STACK MOV SP,R2 ADD #4,R2 .FPP. FGET+IPTR ;GET X .FPP. FDV$+FROM+STACK ;DIVIDE... CMP (SP)+,(SP)+ ;POP STK JSR PC,XFATN2 ;RECURSE INC BE ;*2 CMP (SP)+,(SP)+ RTS PC $13.2: .FPP. FPUT+INTO+STACK .FPP. FML$+FROM+STACK ;X^2 .FPP. FDV$+IMMED 3,70000 .FPP. FNG$ .FPP. FAD$+IMMED 64376,63146 ;0.2 .FPP. FML$+FROM+STACK .FPP. FML$+FROM+STACK .FPP. FSB$+IMMED 52777,52525 ;1/3 .FPP. FML$+FROM+STACK .FPP. FML$+FROM+STACK ;*X^2 .FPP. FAD$+DIRECT,FLTONE ;ADD 1 .FPP. FML$+FROM+STACK ;MULTIPLY WHOLE THING BY X CMP (SP)+,(SP)+ RTS PC ; ;FAST SINE,COSINE ;SMALL: 51(10) WORDS ;SIN(X)=COS(P1/2-X) ;COS(4X)=8+1 ;COS(X)=1-X^2/2+X^4/24-X^6/720 ; =1-X^2*(1-X^2/12+X^4/360)/2 ; =1-X^2*(1-X^2*<1-X^2/30>/12)/2 ; =1+S*(1+S*<1+S/30>/12)/2 FSIN: .FPP. FML$+DIRECT,AMPEIG ;CONVERT INPUT FSNR: .FPP. FNG$ ;SIN(X)=COS(PI/2-X) .FPP. FAD$+IMMED ;... 166001, 62207 ;PI/2=1.570796 BR FSCCM ;GO GET IT! FCOS: .FPP. FML$+DIRECT,AMPEIG ;MULTIPLY INPUT BY CONVERSION FACTOR FSCCM: JSR PC,FCOS2R ;CALL REAL COSINE ROUTINE RTS PC ;RETURN... FCOS2R: OPEN+STACK ;USE STACK AS TEMPORARY STORAGE CLR PTR ;CLEAR COUNTER .FPP. FPUT+INTO+STACK ;SAVE X .FPP. FML$+FROM+STACK ;TAKE X SQUARED. TST @#BE ;X^2<125? BLT FCOS2 ;YES MOVB @SP, PTR ;COPY EXPONENT OF TWO MOVB #-1, @SP ;0 IF EVEN ASR PTR ;FIND RESULT IF DIVIDED BY FOUR (EXP-2). BCS 1$ ;=-1 IF ODD ASLB @SP ;=-2 IF EVEN 1$: INC PTR ;SET COUNTER .FPP. FGET+FROM+STACK ;COPY RESULT .FPP. FML$+FROM+STACK ;S=-X^2 FCOS2: .FPP. FNG$ ;... .FPP. FPUT+INTO+STACK ;PUT S ON STACK. .FPP. FDV$+IMMED ;TAKE FIRST FRACTION 5,74000 ;30 .FPP. FAD$+DIRECT,FLTONE ;COMPUTE INNER EXPRESSION .FPP. FDV$+IMMED ;... 4,60000 ;12 .FPP. FML$+FROM+STACK ;FIND ( ) .FPP. FAD$+DIRECT,FLTONE ;... DEC @#BE ;DIVIDE BY TWO (EXP-1) .FPP. FML$+FROM+STACK ;COMPUTE LAST OF SERIES FCOS4: .FPP. FAD$+DIRECT,FLTONE ;... DEC PTR ;COUNT "RECURSIONS" BGE QSQX JMP SQX ;FIX RANGE-OF-BRANCH PROBLEM QSQX: .FPP. FPUT+INTO+STACK ;FIND COS^2 .FPP. FML$+FROM+STACK ;... .FPP. FPUT+INTO+STACK ;SAVE COS^2 .FPP. FML$+FROM+STACK ;COS^4 .FPP. FSB$+FROM+STACK ;COS^4-COS^2 ADD #3, @#BE ;MULTIPLY BY EIGHT. BR FCOS4 ;REPEAT ; FLTONE: 1,040000 ;CONSTANT OF ONE. ;FINT HANDLER ; ;FINT(INT. VECTOR ADDR,GROUP.LINENO,CSR ADDR,WORD) ;FINT(PRI,INT.VECTOR.ADDR,GROUP.LINE,CSR,WORD) IF MULTIPLE INTERRUPTS ; .IF NDF,EPACC ;IF EXTERNAL PAGE IS A NO-NO XFINT: ERROR+201+24.+24. ;THEN FINT IS OUT, GUYS. .IFF ;HOWEVER ;------- ;DO INTERRUPT SETUP HERE .IF DF,ONEINT XFINT: .FPP. FINT ;GET IVA CMP AC,#30 ;CAN'T BASH EMT! BNE FI.2NT ERFINT: ERROR+201+24.+24. FI.2NT: BIT #1,AC BNE ERFINT MOV #144340,@#PSWEXT ;SET PREV KERNEL MODE AND ;INHIBIT INTERRUPTS MOV #FINTSV,-(SP) ;GET INT. VECTOR ADDR BIC #177700,@SP ;REMOVE ALL BUT D.I.B. FIELD BIS #140000,@SP ;SET INTO 24-28K REGION MOV @SP,-(SP) ;(NEED AN EXTRA COPY OF THIS...) MTPI @AC ;ZAP INTO KERNEL SPACE MOV #50340,-(SP) ;SET A SUPERVISOR MODE PSW MTPI 2(AC) ;SAVE IN KERNEL SPACE ;SET UP SUPERVISOR STACK POINTER NOW MOV #154340,@#PSWEXT ;SET PREVIOUS SUPER MODE ADD #SUPRSP-FINTSV,@SP ;STACK TOP AREA HERE MTPI SP ;SET UP STACK ; ;NOTE THAT THE LOWEST LEGAL ADDRESS IN SUPER SPACE WILL BE ;FINTSV!!!. ALSO, PRI 7 WILL BE PRIORITY WHILE CPU IS IN THAT MODE ; MOV #174000,@#PSWEXT ;RETURN TO PRI 0 FOR A MOMENT ;DON'T USE GETLN HERE, USE EVAL EVALX$ ADD #8.,BE ;MULTIPLY BY 256 TO GET GRP.LINE .FPP. FINT ;INTEGERIZE TO AC MOV AC,INTLNN ;SAVE FOR PROCESS EVALX$ ;GET ARG .FPP. FINT ;MAKE INTEGER MOV AC,INTCSR ;SAVE CSR ADDR EVALX$ .FPP. FINT ;ANOTHER INTEGER MOV AC,INTWRD ; RTS PC ; RETURN AFTER SETTING UP THE REST OF ;SUPERVISOR SPACE STUFF IN COMMON CODE BELOW. .IFF XFINT: .FPP. FINT BIC #-20,AC ;PRIO 1 TO 15 LEGAL BEQ ERFINT ;0 ILLEGAL MOV AC,-(SP) ;SAVE ON STACK EVALX$ ;GET IVA .FPP. FINT CMP AC,#30 ;EMT-BASHING BY FOCAL IS A NO-NO BNE FI.2NT ERFINT: ERROR+201+24.+24. FI.2NT: BIT #1,AC ;ODD ADDR LOSES TOO BNE ERFINT MOV #144340,@#PSWEXT ;SET PREV KERNEL MODE AND ;INHIBIT INTERRUPTS MOV #FINTSV,-(SP) ;GET INT. VECTOR ADDR BIC #177700,@SP ;REMOVE ALL BUT D.I.B. FIELD BIS #140000,@SP ;SET INTO 24-28K REGION MOV @SP,-(SP) ;(NEED AN EXTRA COPY OF THIS...) MTPI @AC ;ZAP INTO KERNEL SPACE MOV #50340,-(SP) ;SET A SUPERVISOR MODE PSW BISB 4(SP),@SP ;SET PRIO IN COND. CODES MTPI 2(AC) ;SAVE IN KERNEL SPACE ;SET UP SUPERVISOR STACK POINTER NOW MOV #154340,@#PSWEXT ;SET PREVIOUS SUPER MODE ADD #SUPRSP-FINTSV,@SP ;STACK TOP AREA HERE MTPI SP ;SET UP STACK ; ;NOTE THAT THE LOWEST LEGAL ADDRESS IN SUPER SPACE WILL BE ;FINTSV!!!. ALSO, PRI 7 WILL BE PRIORITY WHILE CPU IS IN THAT MODE ; MOV #174000,@#PSWEXT ;RETURN TO PRI 0 FOR A MOMENT EVALX$ ;GET GROUP,LINE ADD #8.,BE ;MULT BY 256 TO GET GROUP.LINE .FPP. FINT ;GET LINE # ASL @SP ;MAKE OFFSET OF PRIO NOW MOV @SP,TEMP MOV AC,INTLNN(TEMP) ;SAVE LINENUMBER EVALX$ ;GET CSR .FPP. FINT MOV @SP,TEMP MOV AC,INTCSR(TEMP) ;SAVE CSR ADR EVALX$ .FPP. FINT ;MASK FOR INTERRUPTS MOV (SP)+,TEMP ;FINALLY DONE WITH PRIO HERE MOV AC,INTWRD(TEMP) ;AFTER THIS USE ; RTS PC ;...BYE... ;RETURN AFTER FINISHING SETUP. THIS DOES NOT DEPEND ;ON WHETHER 1 OR 15 INTERRUPTS ARE ALLOWED, SO MAKE IT COMMON. .ENDC ;COMMON SUPERVISOR SPACE SETUP HERE JSR R5,S.RSAV ;SAVE REGISTERS DURING THIS... CLR TEMP ;GET LO HALF OF FINTSV ADDR MOV #FINTSV,AC JSR PC,COM18 ;USE FBUS SUB MOV TEMP,R5 ;PUT INTO R5/R4 PAIR REGS MOV #2,TEMP MOV #FINTSV,AC ;(SAFETY) JSR PC,COM18 MOV TEMP,R4 ;R4,R5 NOW HAVE FINTSV ADDR ASHC #-6,R4 ;SHIFT OFF D.I.B. BIC #170000,R5 ;GET SAF FOR APR6 (24-28K) MOV R5,@#SPAR6 ;SET SUPER MODE APR6 UP MOV #77406,@#SPDR6 ;4K, R/W MOV #77406,@#SPDR7 ;4K R/W EXTERNAL PAGE MOV #7600,@#SPAR7 ;AT USUAL ADDRESSES ;NOW SET UP SOME KERNEL-MODE CODE IN APR0 MOV @#KPDR0,@#SPDR0 MOV @#KPAR0,@#SPAR0 ;SET UP KNL AND SUPER SAME KNLBAD=550 ;KERNEL ADDRESS FOR AN "RTI" FROM SUPER MODE ;THAT WILL JUST POP PS OFF STACK PRE-INTERRUPT MOV #154340,@#PSWEXT ;SET PREV SUPER ;AND DON'T LET KERNEL KNOW ; ;SUPER APR0 IS SAME AS KNL APR0 NOW MOV #KNLBAD,R0 MOV #KNLCD$,R1 ;CODE TO STUFF STARTING AT "KNLBAD" MOV #KNLSZ$,R2 ;WC OF CODE TO STUFF. ; ;N.B.--CODE MUST END BELOW 1000 (START OF EXEC) AND MUST ; NOT FALL ON ANY INTERRUPT VECTORS. ; 5$: MOV (R1)+,-(SP) ;GET A WORD OF CODE MTPI (R0)+ DEC R2 ;COUNT DOWN BGT 5$ MOV #174000,@#PSWEXT ;LET INTS HAPPEN AGAIN ;THINGS SEEM ABOUT DONE NOW. RSX WILL HOPEFULLY NOT FIND OUT ;WHAT'S UP SO WE CAN GET AWAY WITH IT. ; ; *********** ; USERS: ; ; ONLY 1 COPY OF FOCAL CAN DO THIS AT A TIME ; INTERRUPTS MUST BE DISABLED BY THE INTERRUPT HANDLER ; AT INTERRUPT TIME OR THE SYSTEM MAY DIE WHEN FOCAL ; EXITS AND SOMETHING ELSE COMES IN IN ITS PLACE. ; ; ===> BE CAREFUL!!! <=== ; JSR R5,S.RRES RTS PC KNLCD$: MOV #10340,@#177776 ;KNL MODE, PREV IS SUPER MODE ;PRI 7 SO NO INTS JUST NOW ;COPY SUPERVISOR STACK AND DO RTI MFPI SP ;1ST STEP--GET SUPER STACK ADD #2,@SP ;SUPER SP+2=OLD PS MFPI @(SP)+ MFPI SP ;(SP) NOW IS SUPER SP MFPI @(SP)+ MFPI SP ;SUPER SP ADD #4,@SP MTPI SP ;BUMP ARGS OFF MOV #34340,@#177776 ;COVER TRACKS RTI ;GO TO WHEREVER LOOKING LIKE PREV USER KNLSZ$=<.-KNLCD$>/2 ;NUMBER OF WORDS IN SERVICE ROUTINE .ENDC ; ;FAND--AND OF 2 ARGS, INTEGER ; XFAND: .FPP. FINT ;ARG AS INTEGER TO AC MOV AC,-(SP) ;SAVE ON STACK EVALX$ .FPP. FINT ;INTEGERIZE IT COM AC BIC AC,@SP ;AND CLR LORD MOV (SP)+,HORD MOV #17,BE ;INTEGER RTS PC XANDX: ERROR+201+23.+23. ; ;STRING FUNCTIONS ; .IF NDF,NOSTRG ;FSTRD(SUB,VECTOR,LENGTH)--READ A STRING OFF CONSOLE XFSTRD: .FPP. FINT ;INTEGERIZE SUBSCRIPT MOV AC,-(SP);SAVE GETC$ ;PASS COMMA JSR PC,GETARG ;LOCATE VECTOR MOV @PTR,-(SP) ;MAX SUBSCRIPT (WORDS) ASL @SP ;MOST BYTES ALLOWED NOW MOV PTR,-(SP) ;ADDRESS OF VECTOR ADD #4,@SP ;ADJUST TO DATA EVALX$ ;GET MAX LENGTH .FPP. FINT ;MAKE INTEGER MOV 2(SP),R0 ;MAX SUB BYTES SUB 4(SP),R0 ;SEE IF OK CMP R0,AC ;DONT LET MAX GO PAST END OF VECTOR BHI 1$ MOV AC,R0 ;USE SMALLER 1$: ADD 4(SP),@SP ;ADDR TO START AT MOV @SP,4(SP) ;COMPRESS... CMP (SP)+,(SP)+ ;STACK JSR R5,S.RSAV ;ACQUIRE ALL REGS CLR AC ;COUNTER IN 2$: JSR R5,XI33 ;INCH=READ CHAR BIC #-200,CHAR ;LEAVE 7 BITS ONLY CMPB CHAR,#15 ;CR? BEQ 3$ ;YES, LEAVE MOVB CHAR,@14(SP) ;NO, SAVE CHARACTER INC 14(SP) ;BUMP OUTPUT ADDR INC AC ;COUNT CHARACTERS DEC R0 ;AVAIL SPACE BGT 2$ 3$: MOV AC,HORD ;FUNCTION RETURNS LENGTH OF STRING MOV #17,BE CLR LORD JSR R5,S.RRES ;GET BACK FOCAL REGS TST (SP)+ ;FLUSH JUNK OFF STACK RTS PC ;BYE NOW... ; ;FSTWT(SUB,VECTOR,LENGTH-IN-BYTES) WRITE STRING ON TERMINAL ; XFSTWT: .FPP. FINT ;INTEGERIZE SUB MOV AC,-(SP);SAVE GETC$ ;PASS COMMA JSR PC,GETARG ;FIND VECTOR MOV @PTR,-(SP) ASL @SP MOV PTR,-(SP) ;SAVE ADDR ADD #4,@SP ;OF DATA IN VECTOR EVALX$ ;EVAL. LENGTH MAX .FPP. FINT MOV 2(SP),R0 SUB 4(SP),R0 CMP R0,AC BLO 1$ MOV AC,R0 ;USE SMALLER OF MAX, VECTOR LENGTH 1$: ADD 4(SP),@SP MOV @SP,4(SP) CMP (SP)+,(SP)+ MOV (SP)+,AC JSR R5,S.RSAV 2$: MOVB (AC)+,CHAR ;GET A CHARACTER JSR R5,XOUT ;OUTCH DEC R0 BGT 2$ JSR R5,S.RRES RTS PC STRERR: ERROR+201+47.+47. ;STRING ERROR ; ;FMOVB(SUB1,VECT1,SUB2,VECT2,LENGTH) MOVE STRING1 INTO STRING2 FOR LENGTH CHARS ; XFMOVB: .FPP. FINT MOV AC,-(SP) ;SAVE SUB1 BEQ STRERR ;0 ILLEGAL GETC$ ;PASS COMMA JSR PC,GETARG ;FIND VECTOR 1 MOV @PTR,-(SP) ;MAX SUB ASL @SP ;ENBYTE CMP 2(SP),(SP) ;SUB TOO BIG? BHI STRERR ;YES, LOSE MOV PTR,-(SP) ;SAVE ADDR EVALX$ ;FIND SUB2 .FPP. FINT ;AS INTEGER MOV AC,-(SP) ;SAVE BEQ STRERR GETC$ ;PASS COMMA JSR PC,GETARG ;FIND VECTOR 2 MOV @PTR,-(SP) ;SAVE MAX SUB ASL @SP ;AS BYTE VALUE CMP 2(SP),(SP) ;SUB>MAX/ BHI STRERR MOV PTR,-(SP) EVALX$ .FPP. FINT MOV AC,R0 ;LENGTH ADD 4(SP),R0 ;SUB2 CMP R0,2(SP) ;MAX2 BHI STRERR MOV AC,R0 ADD 12(SP),R0 ;MAX1 CMP R0,10(SP) ;>MAX1?? BHI STRERR ;YES, LOSE MOV 6(SP),R0 ;INPUT ADDR1 ADD 12(SP),R0 ADD #4,R0 ;DATA ADJUSTMENT MOV 4(SP),R5 ;OUTPUT ADDR ADD @SP,R5 ;(ADDR) ADD #4,R5 ;DATA ADJUSTMENT 1$: MOVB (R0)+,(R5)+ ;COPY DATA A BYTE AT A TIME DEC AC BGT 1$ ADD #14,SP ;REMOVE RUBBISH OFF STACK RTS PC ; ;FINDS(SUB1,VECTOR1,LEN1,SUB2,VECTOR2,LEN2) FIND STRING IN VECT1 IN ; STRING IN VECT2. RETURN SUBSCRIPT IN VECT2 OR 0 ; ;COMMON ROUTINE TO EVALUATE SUB1,VECT1,LEN1,SUB2,VECT2 AND SAVE ON STACK FSLX: .FPP. FINT MOV AC,-(SP) ;SUB1 GETC$ ;PASS COMMA JSR PC,GETVAR ;GET VECTOR MOV PTR,-(SP) EVALX$ ;LEN1 .FPP. FINT MOV AC,-(SP) EVALX$ ;SUB2 .FPP. FINT MOV AC,-(SP) GETC$ ;PASS COMMA JSR PC,GETVAR ;GET VECT2 MOV PTR,-(SP) JMP @12(SP) ;RETURN FROM JSR PC ; XFINDS: JSR PC,FSLX EVALX$ ;LEN 2 .FPP. FINT MOV AC,-(SP) ;SAVE LEN 2 ON STACK TOO ;STACK IS NOW ;RETURN FROM FSLX CALL ;SUB 1 ;VECTOR 1 ADDR ;LENGTH STRING1 ;SUB 2 ;VECTOR 2 ADDR ;LENGTH STRING2 XFCCM: JSR R5,S.RSAV ;GET ALL REGISTERS FOR OUR USE HERE MOV 16(SP),R0 ;VECTOR 2 SUB ADD #4,R0 ;DATA FUDGE FACTOR ADD 20(SP),R0 ;ADDRESS 2 MOV 24(SP),R1 ;SUB1 ADD #4,R1 ADD 26(SP),R1 ;ADDRESS 1 (STRING TO LOOK FOR IN STRING2) MOV 14(SP),R2 ;LEN 2 MOV 22(SP),R3 ;LEN 1 CMP R3,R2 ;IF LOOKING FOR LONGER STRING THAN TGT,FAIL BHI XFSZR ;RETURN 0 VALUE IF FAIL MOV R1,R4 ;R4=SCRATCH ADDR 3 MOV R0,R5 ;R5=ADDR 1 2$: CMPB (R4)+,(R5)+ ;COMPARE BNE 1$ DEC R3 ;SEE IF THE STRINGS ARE THE SAME BLE XFSRTN ;IF GET TO 0, ALL DONE, FOUND IT. BR 2$ 1$: MOV 22(SP),R3 ;IF FAIL ONE, BUMP ADDR2 INC R0 ;BUMP ADDR2 HERE MOV R0,R5 ;LOOK STARTING AT NEXT ADDR MOV R1,R4 DEC R2 ;COUNT DOWN LENGTH OF 2 CMP R2,R3 ;SMALLER THAN SEARCH STRING NOW? BLT XFSZR ;YES, FAIL SEARCH, RETURN 0 BR 2$ ;NO, SEARCH SOME MORE XFSRTN: SUB #4,R0 SUB 16(SP),R0 ;MAKE SUBSCRIPT FROM ADDR AGAIN MOV R0,HORD ;LENGTH CLR LORD MOV #17,BE JSR R5,S.RRES ;RESTORE FOCAL'S REGISTERS ADD #16,SP ;REMOVE RUBBISH... RTS PC ;AND RETURN XFSZR: JSR R5,S.RRES ADD #16,SP ;RETURN 0 CLR LORD CLR HORD CLR BE RTS PC ; ;FCMPS(SUB1,VECT1,LEN,SUB2,VECT2) COMPARE STRINGS, RETURN 0 IF FAIL ; XFCMPS: JSR PC,FSLX ;GET ARGS MOV 4(SP),-(SP) ;COPY LENGTH BR XFCCM ;USE COMMON COMPARE CODE .ENDC ; ;FADR-- FADR(SUBSCRIPT, ARRAY) RETURNS ADDRESS OF ARRAY ELEMENT ; XFADR: .FPP. FINT ;INTEGERIZE FLAC MOV AC,-(SP) ;SAVE SUBSCRIPT GETC$ ;SKIP COMMA JSR PC,GETARG ;FIND ARRAY. ADDR RETURNS IN PTR CMPB -3(PTR),#PRCNT ;CHECK INTEGER TYPE BNE 1$ ;NO SUBSCRIPT IF NOT--GETARG TESTS CMP @SP,@PTR ;INTEGER TYPE. SUBSCRIPT TOO LARGE? BHI 2$ ;YES, CALL ERROR. (GETARG MAY CALL FIRST) MOV PTR,AC ;GET ADDRESS ADD #2,AC ;SKIP MAX SUBSCRIPT CELL ASL @SP ;ENBYTE SUBSCRIPT ADD (SP)+,AC ;GET ADDRESS OF ELEMENT 3$: MOV AC,HORD MOV #17,BE ;RETURN INTEGER CLR LORD ;IN FLAC RTS PC 1$: MOV PTR,AC ;NORMAL FLOATING ELEMENT TST (SP)+ ;FLUSH CALL SUBSCRIPT BR 3$ 2$: ERROR+201+25.+25. ;ERROR -- SUBSCRIPT TOO LARGE .IF NDF,NOSTRG ; ;FTRNS(FUNCTION,VECTOR(SUB),LENGTH) CONVERT TO/FROM INTERNAL CODE, ASCII ; XFTRNS: .FPP. FINT ;INTEGERIZE SUBFUNCTION MOV AC,-(SP) ;SAVE 0/1 GETC$ ;PASS COMMA JSR PC,GETVAR ;LOCATE STRING VRBL MOV PTR,-(SP) ;SAVE ADDRESS ADD -2(PTR),(SP) ;ADDING BYTE DISPLACEMENT ADD #4,@SP ;AND FUDGE FACTOR MOV @PTR,TEMP ;TEST SIZE ASL TEMP CMP -2(PTR),TEMP ;OVER MAX? BLOS 1$ ;NO, BRANCH IF OK 2$: ERROR+201+42.+42. ;TOO HIGH--CALL ERROR 42 1$: EVALX$ ;NOW GET LENGTH OF VARIABLE .FPP. FINT ;INTEGERIZE MOV AC,-(SP) ;SAVE JSR R5,S.RSAV ;NOW SAVE ALL REGISTERS TST 20(SP) ;SUBFUNCTION =0 ? BNE I2AS ;NO, NON-0 ==> INTERNAL TO ASCII MOV 16(SP),R2 ;ADDRESS TO START CONVERSION TO MOV 14(SP),R0 ;LENGTH IN BYTES BMI CLNP20 ;(NEGATIVE ILLEGAL) A2I00: MOVB (R2)+,CHAR ;GET BYTE OF TEXT IN ASCII BIC #177600,CHAR ;ZAP HI BYTE SORTC$ TERMS,A2I01 ;CONVERT IF NEEDED BR A2I02 ;SKIP IF NO CONVERSION A2I01: ADD #200,AC ;MAKE INTERNAL CODE SUB #TERMS,AC MOVB AC,CHAR ;SAVE IN REG A2I02: MOVB CHAR,-1(R2) ;COPY TO BUFFER DEC R0 ;COUNT DOWN BGT A2I00 ;TILL DONE BR CLNP20 ;DONE. VOILA. I2AS: MOV 16(SP),R2 ;GET ADDRESS MOV 14(SP),R0 ;AND LENGTH IN BYTES BMI CLNP20 I2A00: MOVB (R2)+,CHAR ;GET A CHARACTER BPL I2A01 ;IF +, OK NOW BIC #177600,CHAR ;IF -, MAKE ASCII AGAIN MOVB TERMS(CHAR),CHAR ; GET BACK ASCII I2A01: MOVB CHAR,-1(R2) ;SAVE IN BUFFER DEC R0 BGT I2A00 ;DO ALL OF BUFFER. CLNP20: JSR R5,S.RRES ;RESTORE REGISTERS ADD #6,SP ;POP OFF SAVED ARGS RTS PC .ENDC ; ;FIOR--INCLUSIVE OR OF 2 ARGS ; XFIOR: .FPP. FINT ;ARG 1 TO AC MOV AC,-(SP) EVALX$ .FPP. FINT BIS AC,@SP MOV (SP)+,HORD ;SET RESULT THE SAME MOV #17,BE ;EXPONENT TOO CLR LORD RTS PC ;RETURN ;SYMBOL TABLE TYPEOUT ROUTINE ;USED BY *TYPE*ASK* ;VIA 'ATLIST' TDUMP: MOV STARTV, R5 ;INIT POINTER TDUMP1: TST @R5 ;TEST FOR NULL ENTRY BNE TDUMP2 ;GO TYPE NAME, ETC. TD6$: CMPB 1(R5),#PRCNT ;INTEGER TYPE? BNE TDM$3 ;NO MOV 4(R5),-(SP) ;YES. GET MAX SUBSCRIPT ASL @SP ;MAKE BYTES ADD #10,@SP ;SKIP PAST HEADER+DATA ;SUBSCRIPTS START AT 0 ADD (SP)+,R5 ;POINT TO NEXT BR TDM$4 TDM$3: ADD #10,R5 ;MOVE POINTER FOR NORMAL ENTRY TDM$4: TDUMP3: CMP R5, BOTVEC ;TEST LIMITS BLO TDUMP1 ;TRY AGAIN MOV R5,-(SP) ;TEST UPPER BOUND SUB #10,@SP ;SEE IF WITHIN 10 OF IT CMP (SP)+,BOTVEC ;IF OVER IT, OK NOW. ELSE SET BOTTOM BHI 16$ ;IF OVER VECTORS FORGET SETTING MOV BOTVEC,R5 ;1ST TIME LOOK FOR VECTORS 16$: CMP R5,BOTTOM ;AT OR PAST REAL END OF STORAGE? BLO TDUMP1 ;IF NOT LOOK FOR MORE VECTORS. TST (SP)+ ;BUMP STACK ("TASK" RETURN) POPJ ;LEAVE *TYPE*ASK* ; TDUMP2: CMPB 1(R5),#PRCNT ;GOT A VECTOR HERE? BEQ TD7$ ;PRINT V V%(MAX SUB) HERE PRINT2, "S ;MAKE COMMANDS! MOVB (R5)+, CHAR ;READ FIRST LETTER OF NAME N BIC #177600,CHAR ;CLR ANY EXTRA BITS PRNTC$ ;AND PRINT SAME MOVB (R5)+, CHAR ;READ SECOND LETTER ; BLE 1$ ;IGNORE SPACE BIC #177600,CHAR ;CLR BASIC-TYPE ZONES IF NECC PRNTC$ ;AND PRINT 1$: PRINT+ '( ;OPEN PARENTHESIS TST (R5)+ ;ALL ZEROS? BEQ TDUMP4 ;YES TST -(R5) MOVB (R5)+, PTR ;COPY SUBSCRIPT #1 AND TEST SIGN. JSR PC, PRNTS ;PRINT SUBSCRIPT DIGITS. PRINT+ ', ;COMMA MOVB (R5)+, PTR ;COPY LEFT-HAND BITS AND JSR PC, PRNTS ;PRINT SAME TDUMP4: PRINT2, ")= ;CLOSE PARE MOV R5, PTR ;COPY POINTER. .FPP. FGET+IPTR ;LOAD THE VALUE OF THE VARIABLE MOV FISW, PTR ;LOAD FORMAT DATA .FPP. FPRINT ;PRINT CONTENT OF FLAC PRINT2, CRLF ;PRINT CRLF AT END OF LINE CMP (R5)+, (R5)+ ;MOVE POINTER TO NEXT ENTRY SUB #10,R5 BR TD6$ ;CONTINUE THE SCAN TD7$: PRINT2, "V ;PRINT THE V MOVB (R5)+,CHAR ;GET 1ST CHAR BIC #177600,CHAR PRNTC$ MOVB (R5)+,CHAR ;PRINT THE % ON DUMP TOO BIC #177600,CHAR PRNTC$ PRINT+ '( ;PRINT LEFT PAREN SUB #2,R5 ;BACK R5 UP MOV 4(R5),HORD ;GET MAX INTO FLAC CLR LORD MOV #17,BE ;AS INTEGER MOV FISW,PTR ;SET PRINT FORMAT .FPP. FPRINT ;PRINT IT OUT PRINT+ ') ;CLOSE THE PARENTHESIS PRINT2, CRLF ;PRINT CRLF AFTERWARDS JMP TD6$ ;GO TO NEXT SYMBOL .IF NDF,NOSTRG ;FN2S(NUMBER,VECTOR,SUBSCRIPT) CHANGE VECTOR TO ASCII STRING XFN2S: OPEN+STACK ;PUSH NUMBER INTO STACK .FPP. FPUT+INTO+STACK ;SAVE # THERE GETC$ ;PASS COMMA JSR PC,GETARG ;GET VECTOR ADD #4,PTR ;POINT AT DATA MOV PTR,-(SP) ;SAVE ADDR CMP -4(PTR),#10. ;VECTOR TOO SMALL? BGE 1$ ;NO, OK 2$: ERROR+201+46.+46. ;YES, ERROR 1$: EVALX$ .FPP. FINT MOV (SP),R5 MOV -4(R5),R5 ;CHECK PAST END OF VECTOR SUB #10.,R5 CMP R5,AC BLT 2$ ;IF BAD, BRANCH ADD (SP)+,AC ;TOTAL ADDR TO PUT DATA IN MOV AC,OUTADX .FPP. FGET+FROM+STACK ;GET NUMBER CLOSE+STACK ;POP STACK BACK MOV FISW,PTR ;USE WHATEVER FORMAT HE SET MOV OUTADX,-(SP) ;SAVE WHERE HE STARTED .FPP. FPRINT SUB (SP)+,OUTADX ;COMPUTE NO. BYTES WRITTEN TO VECTOR MOV OUTADX,HORD ;RETURN THAT AS FUNCTION VALUE CLR OUTADX ;SET OUTPUT TO DEVICES AGAIN MOV #17,BE CLR LORD RTS PC .ENDC .IF DF,EPACC .IF NDF,ONEINT ;FALRM(NO, DELAY,UNIT,GROUP) MAKE PSEUDO INTERRUPT VIA AST AFTER DELAY ; UP TO "NFAKES" ALARMS PERMITTED. (ASSEMBLY PARAMETER DEFINED EARLIER) ; XFALRM: .FPP. FINT ;INTEGERIZE NUMBER CMP AC,#NFAKES ;TOO BIG NUMBER? BHI 4$ ;IF SO CALL ERROR ; BIC #-4,AC ;RANGE 0-3, BUT 1,2,3 ARE ONLY ONES LEGAL BNE 1$ ;OK IF 1-3 4$: ERROR+201+49.+49. ;ERROR--ILLEGAL MARKIME NUMBER 1$: DEC AC ;MAP TO 0-2 MOV AC,-(SP);SAVE 0-2 OFFSET XFKSZ= ;OFFSET BETWEEN AST ENTRIES ;N.B. -- IF EIS NOT AVAILABLE THIS INSTRUCTION WILL BOMB!!!! ;(OK FOR RSX11D/IAS. MAYBE NOT OK FOR RSX11M.) MUL #XFKSZ,AC ;AC=R1 ODD REGISTER ADD #FAKEI1,AC ;MAKE AST ENTRY ADDR MOV AC,-(SP) ;SAVE ADDR EVALX$ ;GET DELAY MAGNITUDE .FPP. FINT ;MAKE INTEGER MOV AC,-(SP) BEQ 4$ ;0 DELAY ILLEGAL EVALX$ ;GET UNIT, 0=TICKS,1=SEC,2=MIN >2 ILLEGAL .FPP. FINT CMP AC,#3 ;TOO BIG? BHI 4$ ;YUP, MAKE IT LOSE INC AC MOV AC,-(SP) ;SAVE EVALX$ ;GET GROUP NUMBER ADD #8.,BE ;MAKE IT NN.DD .FPP. FINT ;GET INTEGER MOV 6(SP),R5 ;0-2 ASL R5 ;INTERRUPT NUMBER 0-2 NOW 0,2,4 ADD #<2*17.>,R5 ;OFFSET INTO INTERRUPT TABLES NOW MOV AC,INTLNN(R5) ;SAVE FOCAL INTERRUPT SERVICE LINE MOV (SP)+,AC ;UNITS MOV (SP)+,R5 ;DELAY MOV (SP)+,R0 ;ADDR TST (SP)+ ;FLUSH 0-2 OFFSET MRKT$S ,R5,AC,R0 ;SET UP THE AST RTS PC ;GO BACK .ENDC .ENDC .EVEN .PSECT DATA,RW .EVEN ; ;C.S.I. INTERFACE FOR FOCAL LIBRARY ROUTINES. ; ; IMPLEMENTED: ; ; LIBRARY OPEN FILENAME.EXT[UIC]--OPENS OUTPUT FILE ONLY ; ; LIBRARY WRITE LINENUMBERS--OUTPUTS LINES ON OUTPUT FILE OPEN ; (ERROR IF NO FILE OPEN) ; ; LIBRARY READ DEV:FILE.EXT[UIC] -- CHANGES INPUT TO DEV.FILE.EXT[UIC] ; ; LIBRARY C[LOSE] I/O-- CLOSE LIBRARY INPUT OR OUTPUT FILE ; AND RELEASE IT. MUST BE DONE BEFORE ANOTHER ; INPUT OR OUTPUT FILE IS OPENED. ; (ONE OF EACH MAY BE OPEN AT A TIME) ; ; ; ;LIBRARY ERASE DEV:FILE.EXT[UIC] ; DLCSI: .BLKB C.SIZE .EVEN DFNBK: NMBLK$ FOCAL,FCL,0,SY,0 ;DEFAULTS CSIDLN: .WORD DLCSI,DLFDB,DLFL DLFDB: FDBDF$ FDAT$A R.VAR .WORD ERR21 DLLK: .WORD 0 .RAD50 /DLN/ .WORD 1,0 .WORD ERR21 .WORD 0 DLFL: .BLKW 7 LBADR: .WORD LREAD,LOPEN,LWRYT,LCLOS,LWRYT,LDEL,LWRYT,0 LBCHR: .ASCII /ROWCT/ .ASCII /EX/ ;LIB E[RASE] COMMAND ;LIBRARY XECUTE EXECUTES FUNCTION WITH LIB OUTPUT TURNED ON. .BYTE 0 .EVEN ; CSIFIL--FILLS DUMMY CSI BUFFER FOR .CSI1 AND .CSI2 BUPTR: .WORD 0 ;POINTER TO POSITION OF OUTPUT DATA .EVEN .PSECT CODE,RO .EVEN CSIFIL: CLR CBUFHD CLR CBUFHD+4 MOV #CBDAT,BUPTR ;START ADDR FOR DATA OUTPUT CLP1: GETC$ ;GET A CHARACTER BPL CPL2 BIC #177600,CHAR ;REMOVE ANY LEFT-OVER SIGN EXTEND MOVB TERMS(CHAR),CHAR ;RECONSTITUTE ASCII CPL2: MOVB CHAR,@BUPTR ;SAVE IT INC BUPTR ;BUMP FOR NEXT TIME INC CBUFHD INC CBUFHD+4 CMP BUPTR,#CBDAT+80. ;SEE IF PAST END BHIS DUNCSF CMPB CHAR,#15 ;C.R. IS END TOO... BNE CLP1 ;OTHERWISE KEEP PACKING STUFF DEC BUPTR MOVB #15,@BUPTR ;STASH CR FOR C.S.I. INC BUPTR DUNCSF: DEC CBUFHD+4 ;EXCLUDE C.R. FROM STRING MOV @SP,CHAR ;GET POINTER TO CSI BLK NOW ADD #2,@SP ;PASS IT MOV @CHAR,CHAR ;DOUBLE INDIRECTION MOV @CHAR,CHAR ;GET RSX CSIBLK ADDR MOV R0,-(SP) ;SAVE R0 CSI$1 CHAR,#CBDAT,CBUFHD+4 ;DO THE CSI SETUP HERE BCS CSIERR ;COMPLAIN ON BAD SYNTAX MOV (SP)+,R0 ;RESTORE R0 MOVB #CR,CHAR ;REPLACE INTERNAL C.R. CODE FOR PROC DEC AXOUT ;BACK UP POINTER ONE TOO. RTS PC ; ;CSISET CALL IS JSR R5,CSISET, FOLLOWED BY ADDR OF CSIBLK ; CSISET: MOV R5,-(SP) ;SAVE CSIBLK ADDR ADDR MOV @R5,R5 ;CSIBLK ADDRESS TO R5 ; TST @2(R5) ;LINKBLOCK INITED? ; BNE CSPOP2 ;YES, EXIT. DON'T NEED NEW ONE MOV (SP),R5 ;CSIBLK ADDR AGAIN MOV (R5),R5 ;CSIBLK ADDR MOV @R5,R5 ;RSX CSIBLK NOW (DOUBLE INDIRECT) MOV R0,-(SP) MOV R5,R0 CSI$2 R0,OUTPUT ;PARSE THE TRASH NOW BCS CSIERR ;?LOSE? MOV (SP)+,R0 ;RESTORE R0 CSPOP2: MOV (SP)+,R5 ;RETURN ADDR TST (R5)+ ;PASS CSIBLK ADDR RTS R5 ;TO CALLER ; CSIERR: ERROR+201+19.+19. ;FUNNY BUSINESS IN LIBRARY STUFF ; ;LREAD-- TRANSFER INPUT TO LIBRARY FILE. CAN BE TRANSFERRED ; BACK BY *OPERATE* OR *LIBRARY CLOSE INPUT* STATEMENT. ; ; ;LIBRARY READ IS REPLACED BY GCML$ STUFF. IGNORE IT. LREAD: ;ALLOW A LIBRARY READ HERE (1 LEVEL) TO PERMIT CHAINING. ;SORT OF A KLUDGE, SO TRY TO USE @ FACILITY WHERE FEASIBLE. JSR PC,CSIFIL ;GET FILE SPECS .WORD CSIBIN ;USE FAKE CSI STUFF JSR R5,CSISET ;DECODE .WORD CSIBIN MOV R0,-(SP) ;SAVE R0 TST CSILNK ;FLAG SAY WE ALREADY HAVE LIB READ? BEQ 1$ ;NO, GO AHEAD WITH THIS ONE CLOSE$ #CSIFDB ;YES, CLOSE THE OLD ONE CLR CSILNK ;AND FLAG IT CLOSED (IN CASE OF ERR) 1$: FDOP$R #CSIFDB,#6,,#DFNBK,#FO.RD ;READ ACCESS JSR R5,S.RSAV ;SAVE REGS MOV #CSIFDB,R0 MOV R0,CSILNK ;FLAG OPEN MOV #CSIFDB+F.FNB,R1 MOV #CSIBI+C.DSDS,R2 MOV #DFNBK,R3 JSR PC,.PARSE ;PARSE DEFAULT AND GIVEN FN STUFF JSR R5,S.RRES ;GET BACK REGS OPEN$R #CSIFDB,#6,#CSIBI+C.DSDS,,#KBIFIL+12,#1,ERR22 MOV (SP)+,R0 ;REPLACE R0 FINALLY JMP PROCJJ ;INPUT CHANGED...NOW GO. ; ;LDEL--DELETE FILE ; LDEL:; TST DLLK;INITED? JSR PC,CSIFIL .WORD CSIDLN JSR R5,CSISET .WORD CSIDLN;DELETE CSIBLK MOV R0,-(SP) ;SAVE R0 FROM FCS FDOP$R #DLFDB,#4,,#DFNBK,#FO.MFY,#FA.DLK JSR R5,S.RSAV MOV #DLFDB,R0 MOV #DLFDB+F.FNB,R1 MOV #DLCSI+C.DSDS,R2 MOV #DFNBK,R3 JSR PC,.PARSE JSR R5,S.RRES OPEN$M #DLFDB,#4,#DLCSI+C.DSDS,,#KBIFIL+12,#1,ERR21 DELET$ #DLFDB,ERR21 ;ZAP FILE MOV (SP)+,R0 JMP PROCJJ ;END DELETION! ; ; ;LOPEN--OPEN LIBRARY OUTPUT. (DOES NOT WRITE ANYTHING, ONLY DOES THE ; .INIT AND .OPENO. LIBRARY WRITE OR ; LIBRARY TYPE WRITE.) ; LOPEN: JSR PC,CSIFIL .WORD CSIBOU ;GET CSI STUFF JSR R5,CSISET ;DECODE IT .WORD CSIBOU ;OUTPUT CONTROL BLOCKS TST CSILKO ;WAS OUTPUT ALREADY THERE? BNE NOINIO ;YES, BETTER NOT RE-INIT MOV R0,-(SP) MOV #CSOFDB,CSILKO ;FLAG CSI OUTPUT OPEN FDOP$R #CSOFDB,#3,,#DFNBK,#FO.WRT JSR R5,S.RSAV MOV #CSOFDB,R0 MOV #CSOFDB+F.FNB,R1 MOV #CSIBO+C.DSDS,R2 MOV #DFNBK,R3 JSR PC,.PARSE JSR R5,S.RRES OPEN$W #CSOFDB,#3,#CSIBO+C.DSDS,,#KBIFIL+12,#1,ERR22 ;OPEN FILE MOV (SP)+,R0 NOINIO: JMP PROCJJ ;THAT'S ALL THIS TIME. ; ;LWRYT--WRITE ON LIBRARY OUTPUT FILE, WHICH BETTER BE THERE!! ; (HANDLES "L W" AND "L T" COMMANDS. HAVEN'T FIGURED OUT HOW ; TO GET FCHR TO USE THIS YET!) ; ;FORMAT IS L[IBRARY] W (NUMBERS IN FOCAL FORM FOR LINES TO WRITE) ; ; "WRITE" MUST NOT (N*O*T) BE SPELLED OUT--ONLY "W" ALLOWED!) ; LWRYT: TST CSILKO ;ANY OUTPUT DATASET OPEN? BNE 36$ JMP CSIERR ;NO, TELL HIM 36$: CMP KBOLNK,CSILKO ;ALREADY IN USE? BEQ NOSVCO ;YES, SO KEEP IT THAT WAY MOV KBOLNK,KBOSAV ;OTHERWISE KEEP KBD. DDB PTR. NOSVCO: MOV CSILKO,KBOLNK ;COPY DDB POINTER NOW MOV #1,KBOB$+4 ;SET TO WRITE 1 CHAR AT A TIME ; MOV CSILKO+6,KBOLNK+6 ;COPY DEVICE BECAUSE IT IS ;SOMETIMES A FLAG JSR PC,PROC ;PROCESS COMMANDS WITH THIS OUTPUT MOV KBOSAV,KBOLNK ;AND AFTER, RESTORE OUTPUT TO TTY ;(OR WHATEVER...) ; MOV KBOSAV+2,KBOLNK+6 ;DEV. MOV #2,KBOB$+4 ;SET FOR CHARACTER, VT CMP KBOSAV+2,#42420 ;IS IT KB? BEQ 1$ ;YES, BRANCH MOV #1,KBOB$+4 ;NO, ONLY OUTPUT 1 CHARACTER. 1$: CLR KBOSAV CLR KBOSAV+2 JMP PROCJJ ; ;LCLOS-- CLOSE INPUT OR OUTPUT FILE. ;FORMAT LIBRARY CLOSE I OR LIBRARY CLOSE O RESPECTIVELY. ;ILLEGAL SYNTAX SHOULD BE A NO-OP. ; LCLOS: GETC$ ;GET A CHARACTER BPL LCLOS ;SKIP TILL SPACE SEEN (200 INTERNALLY) SPNOR$ ;SKIP SPACE, POINTER I OR O CMPB CHAR,#'I ;INPUT CLOSE? BNE NOIC ;NO, SKIP IT MOV R0,-(SP) RCML$ #INCMLB ;LET USER RESET INPUT TO KB: BY FORCE TST CSILNK ;L R IN PROGRESS? BEQ 1$ ;NO, SKIP CLOSE$ #CSIFDB ;YES, CLOSE IT TOO CLR CSILNK ;FLAG CLOSED AS WELL 1$: MOV (SP)+,R0 ;SINCE GCML$ DOES THIS WORK SPNOR$ ;SKIP SPACES IN CASE HE WANTS "IO" NOIC: CMPB CHAR,#'O ;CLOSE OUTPUT? BNE NOOC ;NO TST CSILKO ;ANY OUTPUT THERE? BEQ NOOC ;NO, FORGET IT. CMP KBOLNK,CSILKO ;USING THAT OUTPUT NOW? BNE 3$ ;NOPE MOV KBOSAV,KBOLNK ;WE WERE. GET BACK OLD OUTPUT. CLR KBOSAV 3$:; .CLOSE #CSILKO ;CLOSE IT MOV R0,-(SP) CLR CSILKO ;FLAG NO MORE CSI OUTPUT CLOSE$ #CSOFDB ;DO THE CLOSE NOW MOV (SP)+,R0 NOOC: JMP PROCJJ ;NOW RETURN. ; ; LIBRARY HANDLER ; LIBRAR:; GETC$ ;SKIP THE "BRARY" IN "LIBRARY" IF PRESENT ; BPL LIBRAR ;BY SKIPPING TO SPACE SPNOR$ ;IGNORE SPACE SORTJ$ LBCHR,LBADR;LBXX ;GO TO PROPER ROUTINE LBXX: ERROR+201+20.+20. ;ILLEGAL LIBRARY CALL ERROR. PROCJJ: TSTB CHAR ;FLUSH CHARACTERS TILL END-LINE BMI PROCJX ;TO CLEAN UP FOR PROC GETC$ BR PROCJJ PROCJX: JMP PROC ;RETURN FROM LIBRARY STUFF ; ;ERROR RETURNS FROM LINK,FILE ERROR CONDITIONS ERR22: ERR21: TST CSILNK ;LIB INPUT THERE? BEQ 1$ ;NO, NO CLOSE CLOSE$ #CSIFDB ;YES, CLOSE IT (OR TRY TO) CLR CSILNK ;FLAG ABSENT 1$: ..3: TST CSILKO ;REMOVE EITHER IF PRESENT BEQ ..4 ; .CLOSE CSILKO MOV #KBOFDB,KBOLNK CLR KBOSAV CLOSE$ #CSOFDB CLR CSILKO ;FLAG NO MORE CSI OUTPUT ; .RLSE #CSILKO ..4: ; TST DLLK ;DELETE DATASET STIL, OPEN? ; BEQ ..21 ;NO ; .RLSE #DLLK ;YES, GET RID OF IT ..21: ERROR+201+21.+21. ;FILE ERROR SOMEWHERE ; ;***********++++++++++ ;RANDOM NUMBER GENERATOR ;FRAN() - A STATISTICALLY RANDOM, PSEUDO-NOISE SHIFT REGISTER ;WITH PERIODICITY = 32767(10). ;AVERAGE = .00060 ;RANGE = +1 TO -1 XRAN: MOV #LSPR, PTR MOV #14, R5 TST HORD ;NON-ZERO ARGUMENT INITIALIZES BEQ XROL MOV #107654,@PTR XROL: MOV @PTR, AC ROL AC BMI .+4 COM AC ;XOR BITS 13+14 ROL AC ROL AC ROL @PTR ;(THANKS JOHN LARKIN!) DEC R5 BGT XROL MOV @PTR, HORD ;RANGE IS +1-1 POPJ ;CHARACTER I/O FUNCTION ;FCHR(-1):INPUT ASCII ;FCHR(FOO):OUTPUT ASCII ;FCHR(213,64+0A,64+0B,-1): 3 OUT AND 1 IN. XCHMO: EVALX$ XCHR: .FPP. FINT ;FORM INT OF ARG. (ENTRY POINT) MOV CHAR, -(SP) ;SAVE NEXT CHARACTER. MOV AC, CHAR ;PREPARE TO PRINT BMI XCHR1 ;BUT PERHAPS GO READ. OUTCH$ ;OUTPUT XCHARG: MOV (SP)+, CHAR ;RESTORE NEXT CHARACTER CMPB CHAR, #214 ;ANY MORE? (I.E. COMMA?) BEQ XCHMO ;YES! POPJ ;RETURN ; XCHR1: INCH$ ;LOOK FOR INPUT BIC #-400, CHAR ;8-BIT ASCII MOV CHAR, HORD ;SAVE RESULT MOV #15., BE ;SET THE EXPONENT BR XCHARG ;... .IF NDF,XRTKB ;FRCHR(CODE) PRINTS CHAR CORRESPONDING TO ASCII CODE ;IF UNBUSY, FRCHR(-1) READS CHAR IF UNBUSY. IF BUSY, RETURNS ;-1 AS VALUE. DOES NOT WAIT FOR I/O COMPLETION--USER MUST AWAIT ;VIA REPEATED TESTS FOR POSITIVE VALUE. ; XFRCHR: .FPP. FINT ;GET CODE TST AC ;CODE MUSTN'T BE ZERO BNE 1$ ;CODE MUSTN'T BE 0 JMP RERR1 1$: BMI RFGTS1 ;IF -, READ CONSOLE JMP RPRNT ;IF +, PRINT CHARACTER AS ASCII BPL RPRNT ;POSITIVE CODE--PRINT IT RFGTS1: ; MOV TEMP,-(SP) ;1$: .WAITR R0,#RBUSY ;TAKE BUSY RETURN IF I/O UNDERWAY ;IMPLEMENT FRCHR VIA A QIO$S TO THE CONSOLE ;ON LUN 22. USING EVENT FLG 22. THIS LUN SHOULD BE ;ASSIGNED TO TI:. I/O IS IN PASS-ALL MODE 1 CHAR AT A TIME. .MCALL QIO$C ;,RDEF$C .PSECT DATA,RW .EVEN RRFLG: .WORD 0 ;FLAG THAT READ IS IN PROGRESS RWFLG: .WORD 0 KBRDAT: .WORD 0 ;DATA READ/WRITTEN (EITHER/OR,NOTE.) .PSECT CODE,RO .EVEN TST RRFLG ;IS DATA BEING READ? BNE RR2$ ;YES, NO QIO NEEDED JSR R5,S.RSAV QIO$C IO.RLB+10,22.,22.,,KBRIOS,,,CODE JSR R5,S.RRES MOV #2,RRFLG ;FLAG IT'S UNDER WEIGH .PSECT DATA,RW KBRIOS: .BLKW 2 KBWIOS: .BLKW 2 KBWBUF: .WORD 0 .PSECT CODE,RO RR2$: JSR R5,S.RSAV ; RDEF$C 22.,CODE ;READ FLAG 22 RDAF$S #EVTFGS ;READ FLAG 22 (AND ALL OTHERS) JSR R5,S.RRES ; TST @#$DSW ;CHECK DSW BIT #40,EVTFGS+2 ;CHECK EVT FLAG BIT WE WANT TO TEST BEQ RBUSY ;IF 0, STILL BUSY. ;OTHERWISE FALL THRU + XMIT CHARACTER RCPYDT: CLR RRFLG ;UNFLAG CLR HORD MOVB KBRDAT,HORD ;ENSURE ZERO HIGH BYTE CLR LORD MOV #17,BE ;MAKE A FLOATNG NUMBER BR RRTN ;CLEAN STACK AND GO RPRNT: TST RWFLG ;IS A WRITE ALREADY GOING ON? BNE RR1$ ;YES, DON'T NEED QIO JUST NOW MOVB AC,KBWBUF ;STASH CHARACTER JSR R5,S.RSAV QIO$C IO.WLB+10,23.,23.,,KBWIOS,,,CODE ;WRITE OUT JSR R5,S.RRES ;USE LUN 23 AND E.F. 23 HERE. ; ; LUN 1=CMD INPUT VIA GCML$ ; LUN 2 = CONSOLE OUTPUT ; LUN 3 IS LIBRARY OUTPUT ; LUN 4 IS LIBRARY DELETE ; LUN 5,6,7,8,9,10.,11,12,13 ARE OPERATE ; P,T,L,V,W,X,Y,Z,G ; LUN 14,15,16,17 ARE USING ; Q,R,S,T ; LUN 18,19,20,21 ARE USING ; 1,2,3,4 ;THESE ARE NEXT. LUN NUMBERS AND EVENT FLG #S WILL BE THE SAME MOV #2,RWFLG ;FLAG I/O GOING NOW RR1$: JSR R5,S.RSAV ; RDEF$C 23.,CODE RDAF$S #EVTFGS ;READ ALL EVENT FLAGS (RSX11M COMPATIBLE) JSR R5,S.RRES ; TST @#$DSW ;SEE IF DONE BIT #100,EVTFGS+2 ;SEE IF E.F. SET (DONE FLAG) BEQ RBUSY ;IF BUSY, TELL PGM WCPYDT: CLR RWFLG CLR LORD MOV #40000,HORD ;RETURN +1.0 ON DONE MOV #1,BE RRTN:; MOV (SP)+,TEMP ;RESTORE TEMP RTS PC RBUSY: MOV #140000,HORD ;-1.0 CLR LORD MOV #1,BE ;SIGN-MAGNITUDE NOTATION BR RRTN ;LEAVE WITH -1 IN RESULT RERR1: ERROR+201+26.+26. ;ILLEGAL CODE .ENDC .EVEN .PSECT CODE,RO .EVEN .IF DF,EPACC ;IF (AND ONLY IF) EXTERNAL PAGE ACCESS ;18-BIT ADDRESS OBTAINING FUNCTIONS ;OPERATE VIA EXTERNAL PAGE COMMON WHICH MUST DEFINE PSWEXT ;AND UPAR0, ADDRESS OF USER PAR 0 REGISTER. XFBUS: ;FBUS(ADDR) FINDS LOW 16 BITS OF ADDR .FPP. FINT ;GET INTEGER ADDR CLR TEMP ;LOW PART FLAG JSR PC,COM18 ;CALL COMMON DECODER RTNBUS: MOV TEMP,HORD ;SAVE ANSWER CLR LORD MOV #17,BE ;IN INTERNAL FMT RTS PC XFBUSH: .FPP. FINT ;FBUSH(ADDR) GETS HI 2 BITS MOV #2,TEMP ;FLAG JSR PC,COM18 ASH #4,TEMP ;PUT RESULT IN BITS 4,5 FOR DEVICES BIC #176017,TEMP ;LET 11/70 EXTRA BITS OUT TOO. BR RTNBUS COM18: JSR R5,S.RSAV ;ACQUIRE THE REGISTERS FOR OUR USE ;(VALUES PRESERVED ACROSS CALL) CLR R5 MOV AC,R4 ;USE R4,R5. AC=%1. MOV R4,R3 ;SAVE APF BIC #160000,R4 ;REMOVE DISPLACEMENT FIELD ASHC #-6,R4 ;CUT OFF DISPLACEMENT IN BLK SWAB R3 ;GET OFFSET FROM APR 0 BIC #177437,R3 ASH #-4,R3 ADD #UPAR0,R3 ;POINT TO PAR NOW ADD @R3,R4 ;PBN=PAF+BN ASHC #-12,R4 ;SHIFT DOWN 10. BITS TST TEMP ;SEE IF HE WANTS R4 (HIGH 2 BITS) BEQ 1$ ;OR R5 (LOW 16) OF ADDR MOV R4,TEMP ;HIGH BITS NEEDED HERE BR 2$ 1$: MOV R5,TEMP 2$: MOV TEMP,@SP ;PUT INTO RETURN R0 JSR R5,S.RRES ;RESTORE REGS OF YORE RTS PC ;AND WE'RE DONE! .ENDC ;EXECUTE USER FUNCTIONS!! ;SET Z=FSBR(GROUPNO,ARG) XFSBR: JSR R5, GTESTW ;LOAD 'LINENO' CLR TEMP ;ZERO SUBSCRIPT JSR PC, WHIPV ;PREPARE AMPERSAND MOV PTR, -(SP) ;SAVE POINTER. EVALX$ ;SAVE ARG. .FPP. FPUT+THROUGH+STACK ;LOAD ARGUMENT MOV CHAR, -(SP) ;SAVE LAST CHARACTER MOVB #CR, CHAR ;LOAD NEW TERMINATOR (C.R.). JSR PC, DO.P2 ;DO THE SUBROUTINE MOV (SP)+, CHAR ;RESTORE LAST R-PAR. MOV (SP)+, PTR ;DIG UP POINTER. .FPP. FGET+IPTR ;RETRIEVE RESULT. POPJ ;RETURN. .IF NDF,XHIST XFMHST: ;FMHST(DAT.ADR,DAT.WC,HIST.ADR,HIST.WC,LOLIM,SCL) ;HISTOGRAMS EVERY INPUT DATA WORD IN A HISTO OF ;SIZE "HIST.WC" SHIFTING RIGHT BY SCL PLACES IF NECC. .FPP. FINT MOV AC,-(SP) ;GET DATA ADDR ON STACK .REPT 5 EVALX$ .FPP. FINT ;GET WC,H.ADR,H.WC,LOLIM,SCL MOV AC,-(SP) ;PUT ONTO STACK .ENDR BIC #-10,@SP ;MASK OFF SCALE TO MAX 7 MOV 10(SP),TEMP ;# DATA WORDS HMLL: MOV #HMLF,-(SP) ;FAKE FOR JSR INTO FHIST .REPT 6 MOV 14(SP),-(SP) ;MOVE ARGS DOWN .ENDR MOV #1,10(SP) ;DATA WC OF 1 JMP FH2R ;LET FHIST DO WORK HMLF: ADD 4(SP),6(SP) ;RTN HERE FROM FHIST RTS PC ADD 4(SP),6(SP) ;UPDATE HISTO START ADDR ADD #2,12(SP) ;BUMP DATA ADDR DEC TEMP ;COUNT WORDS TO DO BGT HMLL ;MORE TO DO, DO NEXT ADD #14,SP ;REMOVE ARGS RTS PC XFHIST: .FPP. FINT MOV AC,-(SP) ;SAVE DATA ADDR EVALX$ .FPP. FINT ;DATA WC MOV AC,-(SP) EVALX$ .FPP. FINT ;HISTO ADDR MOV AC,-(SP) EVALX$ .FPP. FINT ;HISTO WC MOV AC,-(SP) EVALX$ .FPP. FINT ;LOWEST CHANNEL OF HISTO MOV AC,-(SP) ;(SIGNED) EVALX$ .FPP. FINT ;POWER OF 2 TO SHIFT RIGHT BY BIC #-10,AC MOV AC,-(SP) ;(BUT NOT MORE THAN 7) FH2R: JSR R5,S.RSAV ;SAVE REGS MOV 24(SP),R0 ;WC OF DATA MOV 26(SP),R1 ;DATA ADDR MOV 22(SP),R2 ;HISTO ADDR MOV 20(SP),R3 ;HISTO WC DEC R3 ASL R3 ;MAKE BYTES ADD 22(SP),R3 ;KEEP AROUND AS MAX HISTO ADDR FHS.L1: MOV (R1)+,R4 ;ACQUIRE A DATUM MOV 14(SP),-(SP) ;SCALE FACTOR FHS.L2: BLE FHS.L3 ;ZERO? THEN TRY TO HISTOGRAM ASR R4 ;ELSE SCALE BY 1 DEC (SP) ;COUNT DOWN BR FHS.L2 ;AND TEST FHS.L3: TST (SP)+ ;FLUSH STACK CELL OF SHIFT CNT SUB 16(SP),R4 ;SUBTRACT LO LIM OF HISTO BLT FHS.L5 ;MUST BE NON-NEGATIVE OR OUT OF RANGE ASL R4 ;NOW ENBYTE DATA ADD R2,R4 ;ADDR IN HISTOGRAM OF DATUM CMP R4,R3 ;CHECK IF IN HISTO SIZE BHI FHS.L5 ;NO, TOO BAD INC @R4 ;YES, COUNT IT. FHS.L5: DEC R0 ;COUNT WORDS TO HISTOGRAM BGT FHS.L1 ;DO ALL JSR R5,S.RRES ADD #14,SP ;FLUSH ARGS RTS PC .ENDC .IF NDF,XMOV ;FAS(R,L) (ADDR,WC) DO ASR OR ASL ON ENTIRE ARRAY XFASR: MOV #207,-(SP) ;RTS PC MOV #6200,-(SP) ;ASR R0 MOV SP,R0 ;ADDR OF SUB ON STACK BR CMN ;USE COMMON CODE FOR FASR,FASL XFASL: MOV #207,-(SP) MOV #6300,-(SP) ;ASL R0 MOV SP,R0 ;ADDR OF SUB ON STACK CMN: MOV R0,-(SP) ;AVOID Z ERROR .FPP. FINT ;INTEGERIZE ADDR ARG BIT #1,AC ;ENSURE EVEN! BNE FAERR ;ELSE ERROR MOV AC,-(SP) ;SAVE ADDR EVALX$ .FPP. FINT ;WC TST AC ;MUST BE >0 BLE FAERR MOV (SP)+,R5 ;ADDR 1$: MOV (R5)+,R0 ;GET DATA JSR PC,@0(SP) ;DO ASR OR ASL ON R0 MOV R0,-2(R5) ;PUT BACK IN ARRAY DEC AC ;COUNT WORDS BGT 1$ ; ADD #6,SP ;REMOVE SUB RTS PC ;END OF FASR, FASL FAERR: ERROR+201+28.+28. ;ADDRESS ERROR OF SOME SORT ; ;FBYT (ADDR.IN,# CHARS, ADDR OUT) ;COPIES BYTES IN INPUT TO WORDS IN OUTPUT. ;HIGH BYTE OF OUTPUT DATA GUARANTEED TO BE 0 XFBYT: .FPP. FINT ;ADDR IN MOV AC,-(SP) EVALX$ .FPP. FINT ;# CHARS TST AC ;MUST BE >0 BLE FAERR MOV AC,-(SP) EVALX$ .FPP. FINT BIT #1,AC ;OUTPUT ADDR, MUST BE EVEN BNE FAERR MOV AC,-(SP) MOV R5,-(SP) MOV R4,-(SP) MOV R3,-(SP) MOV 12(SP),R5 ;INPUT ADDR MOV 10(SP),R4 ;BYTE COUNT MOV 6(SP),R3 ;OUTPUT ADDR FB.1: CLR @R3 ;CLR TOP HALF OF WORD MOVB (R5)+,@R3 ;COPY BYTE TST (R3)+ ;POINT TO NEXT OUTPUT DEC R4 ;DONE? BGT FB.1 ;NO, CONTINUE MOV (SP)+,R3 MOV (SP)+,R4 MOV (SP)+,R5 ADD #6,SP ;FLUSH SAVED ARGS RTS PC ; ;FMOV(ADDR IN, WC, ADDR OUT) MOVES WORDS XFMOV: .FPP. FINT BIT #1,AC BNE FAERR ;BOTH ADDR MUST BE EVEN MOV AC,-(SP) EVALX$ .FPP. FINT TST AC BLE FAERR MOV AC,-(SP) EVALX$ .FPP. FINT BIT #1,AC ;OUTPUT ADDR BNE FAERR MOV (SP)+,TEMP ;WC MOV (SP)+,R5 ;IN ADDR 1$: MOV (R5)+,(AC)+ ;COPY DATA DEC TEMP BGT 1$ ;ONE WORD AT A TIME TILL DONE RTS PC ;THEN RETURN .ENDC .IF NDF,XLIMIT ;FLIM (ADDR,WC,LO,HI,DEFAULT) WILL SET AN ARRAY AT ADDR ;TO DEFAULT IF VALUES DO NOT LIE BETWEEN LO AND HI. ;USEFUL FOR ZEROING ARRAYS ; XFLIM: .FPP. FINT ;GET ADDR BIT #1,AC ;ODD???!! BEQ 1$ ;NO 3$: ERROR+201+32.+32. ;WOW! 1$: MOV AC,-(SP) ;SAVE IT EVALX$ ;GET WC .FPP. FINT MOV AC,-(SP) ;SAVE WC BLE 3$ EVALX$ ;GET LO DATA WORD .FPP. FINT ;(INTEGER) MOV AC,-(SP) ;ANY VALUE IS OK EVALX$ ;GET HI DATA .FPP. FINT ;(ALSO INTEGER) MOV AC,-(SP) EVALX$ ;GET DEFAULT WORD .FPP. FINT ;LEAVE IN AC MOV 6(SP),TEMP ;ADDR MOV 4(SP),R5 ;WC TO DO 2$: CMP (TEMP),2(SP) ;DATA LESS THAN MIN? BGE 4$ ;NO, BRANCH 5$: MOV AC,@TEMP BR 7$ ;YES, PUT IN DEFAULT 4$: CMP (TEMP),(SP) ;DATA BIGGER THAN MAX? BGT 5$ ;YES 7$: TST (TEMP)+ ;POINT TO NEXT DEC R5 ;COUNT DOWN WORDS BGT 2$ ;GO ON IF NOT DONE ADD #10,SP ;FIX STACK FROM PUSHES RTS PC ; ;FLIMT(ADDR,WC,LOTBL,HITBL,DEFTBL) WORKS AS FLIM BUT USES TABLES ;OF LIMITS FOR MORE FLEXIBLE CUTS ; XFLIMT: .FPP. FINT BIT #1,AC ;ENSURE NOT ODD BEQ 1$ 2$: ERROR+201+35.+35. ;ERROR 35-BAD ADDRESS IN FLIM(T) 1$: MOV AC,-(SP) EVALX$ .FPP. FINT ;WC MOV AC,-(SP) BLE 2$ ;NEG OR 0 WC ILLEGAL EVALX$ .FPP. FINT ;LOTBL BIT #1,AC BNE 2$ MOV AC,-(SP) ;SAVE EVALX$ .FPP. FINT BIT #1,AC BNE 2$ ;TEST FOR ODD ADDR ALWAYS MOV AC,-(SP) EVALX$ ;DEFTBL .FPP. FINT BIT #1,AC ;ODD TBL ADDR? BNE 2$ ;WOW, BAD!! MOV 6(SP),TEMP ;DATA ADDR MOV 4(SP),R5 ;WC TO COUNT DOWN 3$: CMP (TEMP),@2(SP) ;SEE IF BELOW MIN. (ADDR ON STACK NOW) BGE 4$ 5$: MOV @AC,@TEMP ;YES, BASH BR 7$ 4$: CMP (TEMP),@(SP) ;BIGGER THAN MAX? BGT 5$ ;YES, BASH 7$: CMP (TEMP)+,(AC)+ ;UPDATE AC AND TEMP ADD #2,(SP) ADD #2,2(SP) ;UPDATE LO, HI TBL ADDRESSES TOO DEC R5 ;COUNT DOWN WC BGT 3$ ADD #10,SP ;REMOVE RUBBISH OFF STACK RTS PC ; ;FSQUZ(INADDR,COUNT,OUTADDR) IS THE INVERSE OF FBYT. IT TAKES AN ;ARRAY AND PUTS LOWER BYTES OF INPUT WORDS INTO SEQUENTIAL ;BYTES OF OUTPUT WORDS. INADDR MUST BE EVEN. ; XFSQUZ: .FPP. FINT ;GET IN ADDR BIT #1,AC BEQ 2$ 1$: ERROR+201+35.+35. 2$: MOV AC,-(SP) ;SAVE INADDR EVALX$ .FPP. FINT ;BYTE/WORD COUNT (DEPENDS HOW YOU LOOK MOV AC,-(SP) ;AT IT) SAVE WC. BLE 1$ ;COMPLAIN IF NEGATIVE EVALX$ .FPP. FINT ;OUTPUT ADDR ; CMP AC,PC ; BLO 1$ ;BE SURE BIG ENOUGH MOV (SP)+,R5 ;WC TO R5 MOV (SP)+,TEMP ;INPUT ADDR TO TEMP 3$: MOVB (TEMP),(AC)+ TST (TEMP)+ ;BUMP OUTPUT 1, INPUT 2 DEC R5 BGT 3$ ;DO ALL OF ARRAY RTS PC ;EXIT WHEN DONE. .ENDC ;FAST ARGUMENT EVALUATOR ;XECUTE FADC(ARG1,ARG2,ARG3,...,ARGN) XXADC: EVALX$ ;EVALUATE AN ARGUMENT XADC: CMPB CHAR,#214 ;COMMA(=>ANOTHER ARG EXISTS) BEQ XXADC POPJ .IF NDF,NOSTRG ;FS2N(SUBSCRIPT,VECTOR,LENGTH) CONVERT STRING TO NUMBER, RETURN NUMBER ; XFS2N: .FPP. FINT MOV AC,-(SP) CMPB CHAR,#214 ;COMMA? BEQ 1$ 2$: ERROR+201+45.+45. 1$: GETC$ ;PASS COMMA JSR PC,GETARG ;FIND VECTOR ADD #4,PTR ;POINT AT DATA ADD PTR,@SP ;USING SUB AND VECTOR EVALX$ ;NEXT NUMBER .FPP. FINT ;(LENGTH) ADD @SP,AC ;ADDR OF END MOVB @AC,-(SP) ;TERMINATE STRING THERE IF ANYWHERE MOVB #214,@AC MOV AXOUT,-(SP) ;SAVE TEXT READER MOV 4(SP),AXOUT ;DATA ADDR JSR R5,S.RSAV EVALX$ ;EVALUATE RUBBISH JSR R5,S.RRES MOV (SP)+,AXOUT MOVB (SP)+,@AC ;RESTORE BYTE TST (SP)+ ;FLUSH ADDRESS OF STRING RTS PC ;THEN SCRAM... .ENDC ;EXPERIMENTAL FUNCTION ;FX( 1,BUSS. ADDR) ;READ BYTE ;FX( 0,BUSS. ADDR,DATA) ;"AND" WORD ;FX(-1,BUSS. ADDR,DATA) ;LOAD BYTE XEX: .FPP. FINT ASL AC MOV AC, -(SP) ;SAVE FUNCTION CODE CLR -(SP) ;START BUS ADDRESS CMPB #214, CHAR BNE XEX4 XEX2: GETC$ ;MOVE ON. BMI XEX3 ;LEAVE IF TERMINATOR. CMPB CHAR, #60 ;TEST FOR ALPHA BLO XEX2A ;USE EXPRESSION CMPB CHAR, #67 BHI XEX2A BIC #-10, CHAR ;CREATE OCTAL ADDRESS ASL @SP ; ASL @SP ; ASL @SP ; BIS CHAR, @SP ; BR XEX2 ; ; XEM: MOVB AC, @R5 ;LOAD POPJ ;LEAVE ; XEX2A: JSR PC, GETARG ;READ ADDR. VARIABLE. .FPP. FGET+IPTR .FPP. FINT ;CAUTION: BIT 15 IS SIGN BIT MOV AC, @SP XEX3: CMPB #214, CHAR ;COMMA? BNE XEX4 EVALX$ ;READ DATA .FPP. FINT ;PUT INTEGER IN 'AC' XEX4: MOV (SP)+, R5 ;GET ADDRESS MOV (SP)+, PTR ;RESTORE CODE AND TEST. CMP PTR,#4 ;FX(2,ADDR) READS WORD BEQ XERW ;ANYWHERE,BUT MAKES ADDR EVEN CMP PTR,#-4 ;FX(-2,ADDR,CONTENTS) PUTS CONTENTS BEQ XELW ;ANYWHERE BUT EVENS ADDR TST PTR ;CHECK BYTE MODES NOW BMI XEL BGT XER XET: MOV @R5, R5 ;LOGICAL "AND" COM R5 ; " BIC R5, AC ; " XEXIT: MOV AC, HORD ;SAVE RESULT CLR LORD ;EXACTLY... MOV #17, BE ;AS INTEGER. POPJ ;GO BACK TO FUNCTION CONTROL. XER: MOVB @R5, AC ;READ THE UNIBUS BR XEXIT ; ; XEL:; CMP PC, R5 ;PROTECT FOCAL ; BLOS XEM ;FROM CMP R5,#60 ;SAVE RSX DATA NEAR 0 FROM BASH BLO XERR BR XEM ; (PROTECTION OBSOLETE IN RSX!) XELW: BIC #1,R5 ;EVENIZE WORD CMP R5,#60 ;DOES NUMBER LOOK LIKE RSX DATA? BLO XERR ;IF SO, COMPLAIN TO HIM MOV AC,@R5 ;STASH OUR DATA THERE POPJ ;LEAVE XERW: BIC #1,R5 ;EVEN ADDR MOV @R5,AC ;NO CHECKS OF LEGALITY! BR XEXIT ;SAVE RESULT XERR: ERROR+201+13.+13. ;DISALLOWED BUS ADDRESSES. .GLOBL AXIN,BUFR,STARTV,TOP ;AREAS TO PUT BUFBEG INTO, IN "INI" FCLBGN: .IF NDF,RES$F ;IF OVERLAID VERSION .GLOBL $LOAD,OVRCTL MOV #4,OVRCTL ;IN RSX FOCAL, DO NOT OVERLAY THE INITIATOR THIS WAY. ;INSTEAD, PUT OVERLAY AREA INTO A SEPARATE PSECT AND ALLOW RE-USE ;OF INITIALIZING CODE BY PGM IN A MANNER MORE SIMILAR TO PAPER-TAPE ;FOCAL'S METHOD, AND THE "RESIDENT" DOS VERSION'S. .ENDC JMP INIT ;START UP. .END FCLBGN ;BEGIN HERE.