NAMES NAMES PASDDT.MAC PASFQV.PAS P11ABSPAS.MAC P11CLOSE.MAC P11CMREAL.MAC P11DATETM.MAC P11DEF.MAC P11DFAULT.MAC P11DIF4.MAC P11DUMP.MAC P11DVI.MAC P11EISDVI.MAC P11EISMPI.MAC P11EQU.MAC P11EQUM.MAC P11EQUM2.MAC P11EQUS4.MAC P11EXIT.MAC P11EXPSET.MAC P11EXST.MAC P11FIS.MAC P11FORFPP.MAC P11FORTR.MAC P11FPP.MAC P11FPPINI.MAC P11FREQV.MAC P11GCML.MAC P11GEQ.MAC P11GEQM.MAC P11GEQM2.MAC P11GEQS1.MAC P11GEQS4.MAC P11GETPUT.MAC P11GRT.MAC P11GRTM.MAC P11GRTM2.MAC P11HEAP.MAC P11IASRNC.MAC P11INIT.MAC P11INITS.MAC P11INIUNM.MAC P11INN.MAC P11INT4.MAC P11LEQ.MAC P11LEQM.MAC P11LEQM2.MAC P11LEQS1.MAC P11LEQS4.MAC P11LES.MAC P11LESM.MAC P11LESM2.MAC P11MARKP.MAC P11MOVM.MAC P11MPI.MAC P11NEQ.MAC P11NEQM.MAC P11NEQM2.MAC P11NEQS4.MAC P11NOFILE.MAC P11NOFUNM.MAC P11PAGE.MAC P11PBOOL.MAC P11RANDOM.MAC P11RDHLP.MAC P11RDI.MAC P11RDR.MAC P11REAL.MAC P11REDSET.MAC P11RESET.MAC P11REXP.MAC P11RLOG.MAC P11RSQRT.MAC P11RSTRNC.MAC P11RUNCHK.MAC P11SGSIN.MAC P11SINCOS.MAC P11SPLTRL.MAC P11TRACE.MAC P11TWPOW.MAC P11UNI4.MAC P11WRBOOL.MAC P11WRERR.MAC P11WRI.MAC P11WROCT.MAC P11WRREAL.MAC **** PASDDT.MAC .TITLE PASDDT .IDENT /PAS605/ ; ; CORRECTION V6-5 1979-09-20 STD ; ; .MCALL SVTK$S ; ; VARIABLES OF DEBUG: ; GBASIS =-18. HPBOTTOM =-20. LBASIS =-22. LHEAP =-24. LSTACK =-26. CAUSE =-28. BPLAST =-30. BPTABLE =-112. ; = ADDR(BPTABLE) - 1! ; ; ; TSKVEC: .WORD ODD,MEMPROT,BRK,IOTT,PRIV,EMTT,TRPT,FPP ; PAS$LD: .BYTE 3,0 .RAD50 /PAS$LD/ DBG$LD: .BYTE 3,0 .RAD50 /DBG$LD/ HP$LD: .BYTE 3,0 .RAD50 /HP$LD/ ; ; ; STARTING POINT OF WHOLE TASK ; DBGENT: MOV #HP$LD,R0 CALL $LOAD MOV #PAS$LD,R0 CALL $LOAD JMP PAS$IN ; ; ; ROUTINE P.DDT $P.DDT:: ; SVTK$S #TSKVEC,#8. MOV GP,GBASIS(GP) MOV MP,-(HP) ; CALLED THROUGH JSR MP,... MOV 2(HP),MP MOV HEAPBOT(GP),HPBOTTOM(GP) CLR AR ; CAUSE = INITC BIS #100000,SELECTOR(GP) ; V6-5 BR CONT ; IOTT: MOV #1,AR ; HALTC BR CONT ; ODD: MOV #3,AR ; ODD BR CONT ; MEMPROT:MOV #4,AR BR CONT ; BRK: MOV #5,AR ADD #2,(HP) BR CONT ; PRIV: MOV #7,AR BR CONT ; EMTT: MOV #8.,AR BR CONT1 ; TRPT: MOV #9.,AR MOV (HP)+,AD ; TRAP NO * 2 ; V6-5 ASR AD ADD AD,AR CMP AD,#1 ; V6-5 BLT BRK ; ; V6-5 BEQ IOTT ; HALT ; V6-5 BR CONT ; V6-5 ; FPP: MOV #10.,AR BR CONT ; ; CONT1: TST (HP)+ CONT: MOV AR,CAUSE(GP) MOV MP,LBASIS(GP) MOV DAPDDT(GP),LHEAP(GP) MOV SS,LSTACK(GP) MOV LUNTBL+<2*TILUN>(GP),-(SS) ; TTYOUT AS PARAMETER MOV LUNTBL+2(GP),-(SS) ; OUTPUT AS PARAMETER MOV GP,-(SS) ; LINK MOV #DBG$LD,R0 CALL $LOAD ; LOAD DEBUGGER JSR PC,DEBUG$ MOV #PAS$LD,R0 CALL $LOAD ; LOAD USER SEGMENT ; ; INSERT BREAK INSTRUCTION IN USER ; SEGMENT FOR ALL ACTIVE BP'S ; MOV GP,AD ; AD := GP ADD #BPTABLE,AD ; AD = ADDR(BPTABLE) - 1 MOV BPLAST(GP),AR ; AR := BPLAST NEXTBP: TST AR ; IF AR = 0 BEQ BPSSET ; THEN GOTO BPSSET ADD #4,AD ; AD := ADDR(BPTABLE[NEXT].CODEADDR) MOV #104400,@(AD) ; INSERT BREAK INSTR DEC AR ; AR := AR - 1 BR NEXTBP ; GOTO NEXTBP BPSSET: ; ALL BREAKS SET ; CMP CAUSE(GP),#12. ; STARTC (ERIDEBUG) BNE 20$ ; (ERIDEBUG) ADD #4,@HP ; PC:=PC+4 (ERIDEBUG) 20$: CMP CAUSE(GP),#1 ; HALTC BLT 30$ ; IF INITC BEQ 40$ ; IF HALTC RTI 30$: RTS PC 40$: CALL @EXITP(GP) ; ; ; SETBR$:: ; SET BREAK POINT. ; SEARCH FOR 'LINENR' IN CODE SEGMENT AND INSERT BREAK INSTR. ; ; INPUT: ; LINENR ; OUTPUT: ; RES = 0 IF OK ; 1 IF LINENR TOO LARGE ; 2 IF LINENR NOT FOUND ; CODEADDR = CODE ADDRESS OF BREAK INSTRUCTION ; LINENR = UNCHANGED IF RES = 0 ; MAXLINENR IF RES = 1 ; LUB(LINENR) IF RES = 2 ; ; ; OFFSET IN LINEELEMENT LINENO = 2 ; SOURCE LINE NR BREAKINST= 6 ; TRAP INSTR. FOR BREAK POINT PREVLINE = 8. ; ADDRESS OF PREVIOUS LINEELEMENT ; ; OFFSET FOR GLOBAL VAR 'LASTLINEELEM' LASTLINE = -16. ; ; STACK ON ENTRY: ; (SS) : STATLINK (NOT USED) ; 2(SS) : LOC(RES) ; 4(SS) : LOC(CODEADDR) ; 6(SS) : LOC(LINENR) ; ; (SS) NOW USED TO HOLD LOCAL VAR 'OLDLINENR' ; MOV #PAS$LD,R0 CALL $LOAD ; LOAD USER PROGRAM CLR (SS) ; OLDLINENR := 0 MOV LASTLINE(GP),AD ; AD := LASTLINEELEM MOV @6(SS),AR ; AR := LINENR MOV LINENO(AD),R ; R := CURLINENR CMP AR,R ; IF LINENR <= CURLINENR BLE LOOP ; THEN GOTO LOOP MOV #1,@2(SS) ; RES := 1 (*TOO LARGE*) MOV R,AR ; LINENR := CURLINENR BR FINISH ; GOTO FINISH LOOP: CMP R,AR ; IF CURLINENR <= LINENR BLE CHECK ; THEN GOTO CHECK MOV R,(SS) ; OLDLINENR := CURLINENR MOV PREVLINE(AD),AD ; LINEELEM := LINEELEM^.PREVLINE BNE 10$ ; IF LINEELEM <> NIL THEN THEN GOTO 10$ CLR R ; CURLINENR := 0 BR LOOP ; GOTO LOOP 10$: MOV LINENO(AD),R ; CURLINENR := LINEELEM^.LINENO BR LOOP ; GOTO LOOP CHECK: CMP R,AR ; IF CURLINENR = LINENR BEQ FOUND ; THEN GOTO FOUND MOV #2,@2(SS) ; RES := 2 (*NOT FOUND*) MOV (SS),AR ; LINENR := OLDLINENR BR FINISH ; GOTO FINISH FOUND: MOV #104400,BREAKINST(AD) ; LINEELEM^.BREAKINST := 104400B CLR @2(SS) ; RES := 0 (*OK*) FINISH: TST (SS)+ ; POP STACK (OLDLINENR) TST (SS)+ ; POP STACK (LOC(RES)) ADD #BREAKINST,AD ; AD := ADDR(LINEELEM^.BREAKINST) MOV AD,@(SS)+ ; RETURN CODEADDR AND POP STACK MOV AR,@(SS)+ ; RETURN LINENR AND POP STACK MOV #DBG$LD,R0 CALL $LOAD ; LOAD DEBUGGER RTS PC ; ; ; CLRBR$:: ; CANCEL BREAK POINT BY INSERTING THE INSTRUCTION 5727B (TST) ; IN LOCATION 'CODEADDR' OF CODE SEGMENT. ; INPUT PARAM 'CODEADDR' ON STACK. ; MOV #PAS$LD,R0 CALL $LOAD ; LOAD USER PROGRAM TST (SS)+ ; POP STATLINK OFF STACK MOV #5727 , @(SS)+ ; INSERT TST IN LOC 'CODEADDR' MOV #DBG$LD,R0 CALL $LOAD ; LOAD DEBUGGER RTS PC ; .END DBGENT **** PASFQV.PAS (*$M-,D-,T-,R-,Q-*) (* PASFQV.PAS *) TYPE LINEELEMP = ^ LINEELEM; LINEELEM = RECORD MOV: INTEGER; LINENO: INTEGER; OFFS: INTEGER; TST: INTEGER; PREVLINE: LINEELEMP; INC: INTEGER; COUNT: INTEGER END; STR10 = PACKED ARRAY (.0..9.) OF CHAR; TEXT = PACKED FILE OF CHAR; PROCEDURE PASFQV ( VAR F: TEXT; FN: STR10; LP: LINEELEMP ); VAR N,J,K: INTEGER; EXT: ARRAY(.0..3.) OF CHAR; FILNAM: PACKED ARRAY(.0..19.) OF CHAR; BEGIN N:=0; EXT:='.FQV'; FILNAM:=' '; WHILE (N<=9) AND (FN(.N.)<>'.') DO BEGIN FILNAM(.N.):=FN(.N.); N:=N+1; END; FOR J:=0 TO 3 DO FILNAM(.N+J.):=EXT(.J.); REWRITE ( F, FILNAM ); IF IORESULT ( F ) >= 0 THEN BEGIN WRITELN ( F, 'STATISTICS FROM EXECUTION OF ', FN : N ); WRITELN ( F, '==========================================' : N + 29 ); WRITELN ( F ); WRITELN ( F, 'SOURCE CODE LINE NUMBER / NUMBER OF TIMES EXECUTED' ); WHILE LP <> NIL DO WITH LP^ DO BEGIN WRITELN ( F, LINENO, COUNT ); LP := PREVLINE; END; END; END (* PASFQV *).  **** P11ABSPAS.MAC .TITLE ABSPAS .IDENT '800530' ; CORRECTION GP-V6:21 1980-05-30 GP ; .MCALL QIO$S,WTSE$S,FDOF$L ; FDOF$L ; ; procedure setwd( addr,newcont: integer ); ; SETWD:: MOV 2(SS),@4(SS) ADD #6,SS RTS PC ; ; function getwdi( addr: integer ): integer; ; function getwds( addr: integer ): set of 1..16; ; GETWDI:: GETWDS:: MOV @2(SS),4(SS) ADD #4,SS RTS PC ; ; procedure setbyte( addr,newcont: integer ); ; SETBYT:: MOVB 2(SS),@4(SS) ADD #6,SS RTS PC ; ; function getbyte( addr: integer): integer; ; GETBYT:: MOVB @2(SS),4(SS) ADD #4,SS RTS PC ; ; ; PROCEDURE ATTACH( VAR F: FILE); ; PROCEDURE DETACH( VAR F: FILE ); ; ATTACH:: MOV #IO.ATT,AR BR ATT2 DETACH:: MOV #IO.DET,AR ATT2: MOV 2(SS),R ; FILE POINTER BIT #TTY,FILTYP(R) BEQ 1$ MOV #TILUN,AD BR 2$ 1$: MOVB F.LUN+FDB(R),AD ; GP-V6:21 2$: QIO$S AR,AD,#5,,SS ; GP-V6:21 WTSE$S #5 ; GP-V6:21 MOVB @SS,AD MOV AD,IORESULT(R) CMP (SS)+,(SS)+ ; SKIP PARAMETERS RTS PC ; ; .END **** P11CLOSE.MAC .TITLE P11CLOSE .IDENT '800806' ; CORRECTION V4-53 1977-10-13 STD ; CORRECTION V4-54 1977-10-13 STD ; CORRECTION V5-16 1978-12-29 STD ; CORRECTION V6-2 1979-08-31 STD ; CORRECTION GP-V6:26 1980-05-31 GP ; CHANGE GP-V6:45 1980-06-10 GP ; CORRECTION GP-V6:56 1980-08-06 GP .MCALL FDOF$L, CLOSE$ FDOF$L ; DEFINE FDB OFFSETS ROUTINE CLOSF ; FINAL CLOSE OF PASCAL FILE ; ; (SS) POINTER TO FILE POINTER ; FINDFILE (SS)+ BIT #SPOOL,FILTYP(R) ; PRINT FILE IF SPOOLING REQUESTED BEQ 10$ CALL .PRINT ; THIS ALSO CLOSES FILE 10$: BIT #TEMPORARY,FILTYP(R) ; IF TEMP FILE, MARK FOR DELETE BEQ 20$ CALL .MRKDL 20$: ; DO NORMAL FILE CLOSE -- THIS IS NOT NECESSARILY THE FINAL CLOSE ; IT CAN BE DUE TO A RESET ON AN OPEN FILE. ROUTINE CLOSP ; R = ADDR OF FILE POINTER ; AR = ADDR OF FILES'S FDB MOV AD,-(SS) ; SAVE REGISTER BIT #TEXT,FILTYP(R) BEQ 40$ ; BR IF NON-TEXT BIT #INPUT,FILTYP(R) BNE 30$ ; BR IF INPUT FILE CMP 2(R),#TEXTBUFFDIZE ; IF OUTPUT FILE BUFFER BEQ 30$ ; IS NOT EMPTY CALLSS PUTL2 ; THEN PUT OUT CURRENT LINE. 30$: BIT #TTY,FILTYP(R) BNE 50$ ; BR IF TTY 40$: CLOSE$ AR ; DO FCS CLOSE MOVB F.LUN(AR),AD ; = FILE'S LUN ASL AD ; = WORD OFFSET IN LUN TABLE ADD GP,AD CLR LUNTBL(AD) ; CLEAR LUN TABLE ENTRY CLRB F.LUN(AR) ; CLEAR LUN IN FDB ALSO 50$: MOV (SS)+,AD ; RESTORE REGISTER RETURN ; ; PROCEDURE CLOSEF ( VAR F: FILE ); EXTERN ; ; CLOSEF:: CLOSF1:: ; PROVIDE ALIAS ENTRY POINTS SO CLOSF2:: ; THAT USER CAN CLOSE SEVERAL CLOSF3:: ; TYPES OF FILES IN SAME PROGRAM. CLOSF4:: ; GP-V6:24 TST (SS)+ ; SKIP MP LINK ; V4-54 CALLSS CLOSF RTS PC .END **** P11CMREAL.MAC .TITLE P11CMR REAL COMPARISON ROUTINES .IDENT '805030' ; CHANGE GP-V6:20 80-05-30 GP ;********************* EQUR ************************* ; ; ROUTINE EQUR ENDEQR CALLSS CMR BEQ CMTRUE BR CMFALSE ;******************************* NEQR ******************************* ROUTINE NEQR ENDNQR CALLSS CMR BNE CMTRUE RTS MP ;****************************** LESR ******************************* ROUTINE LESR ENDLSR CALLSS CMR BLT CMTRUE BR CMFALSE ;************************** LEQR ******************************* ROUTINE LEQR ENDLQR CALLSS CMR BLE CMTRUE BR CMFALSE ;************************* GRTR ****************************** ROUTINE GRTR ENDGRR CALLSS CMR BGT CMTRUE BR CMFALSE ;************************** GEQR ******************************* ROUTINE GEQR ENDGQR CALLSS CMR BGE CMTRUE ;************************************************************* CMFALSE: CLR (SS) ;RETURN BOOLEAN FALSE RTS MP CMTRUE: MOV #1, (SS) ;RETURN BOOLEAN TRUE RTS MP ;****************************** CMR *************************** ; ; COMPARE TWO REAL NUMBERS ON SS STACK (CALL THEM A AND B). ; ; INPUT: ; SS+6 LOW PART OF A ; SS+4 HI PART OF A ; SS+2 LOW PART OF B ; SS HI PART OF B ; ; OUTPUT: ; A AND B REMOVED FROM STACK, ; (SS) = -1 IF A WAS LESS THAN B, ; = 0 IF A WAS EQUAL TO B, ; = +1 IF A WAS GREATER THAN B, ; PSW CONDITION CODE: N AND Z BITS SET ACCORDING TO (SS). ; $CMR: CLR R0 ;ZERO RESULT CLR R1 ;INIT COMPLEMENT FLAG TST (SS) ;TEST SIGN OF B BLT CMR2 ;BR IF B IS NEGATIVE TST 4(SS) ;TEST A'S SIGN BLT CMRLT ;A NEG & B POS MEANS LT RESULT BR CMRCMP ;GO COMPARE VALUES CMR2: TST 4(SS) ;TEST A'S SIGN BGE CMRGT ;A POS & B NEG MEANS GT RESULT ; GET HERE IF BOTH A AND B ARE NEGATIVE BIC #100000,(SS) ;REMOVE B'S SIGN BIC #100000,4(SS) ;REMOVE A'S SIGN INC R1 ;SET COMPLEMENT FLAG CMRCMP: ;COMPARE VALUES OF A AND B CMP 4(SS), (SS) ;COMPARE HIGH PARTS BGT CMRGT BLT CMRLT CMP 6(SS), 2(SS) ;COMPARE LOW PARTS (UNSIGNED) BHI CMRGT BLO CMRLT BR CMR8 ;EQUAL CMRLT: DEC R0 ;RESULT := -1 BR CMR6 CMRGT: INC R0 ;RESULT := +1 CMR6: TST R1 ;IF COMPLEMENT FLAG IS SET BEQ CMR8 ;THEN NEG R0 ;NEGATE THE RESULT CMR8: ADD #6, SS ;REMOVE A & B MOV R0, (SS) ;RETURN RESULT AND SET PSW CC RTS MP .END **** P11DATETM.MAC .TITLE DATETM ; .MCALL GTIM$S ; ; YEAR= 0 MONTH= 2 DAY= 4 HOUR= 6 MIN= 10 SEC= 12 TICK= 14 TICMAX= 16 ; DIV10: MOV #'0,R 1$: SUB #10.,AR BLT 2$ INC R BR 1$ 2$: ADD #58.,AR ; CONVERT TO ASCII DIGIT MOVB R,(AD)+ ; TENS MOVB AR,(AD)+ ; UNITS RTS PC ; MUL60: ASL AD ASL AD MOV AD,R ASL AD ASL AD ASL AD ASL AD SUB R,AD RTS PC ; GETTIM: SUB #20,SS GTIM$S SS RTS PC ; ; ; .MACRO CNVRT A,B MOV A,AR JSR PC,DIV10 .IIF NB MOVB B,(AD)+ .ENDM CNVRT ; ; ; ROUTINE TIME MOV (SS)+,AD JSR PC,GETTIM INC AD CNVRT HOUR(SS),#': CNVRT MIN(SS),#': CNVRT SEC(SS),#'. ASL TICK(SS) MOV TICK(SS),AR ASL AR ASL AR ADD TICK(SS),AR ; MUL BY 10. ; NOW DIVIDE BY TICKMAX TO GET TENTH OF SECOND MOV #'0,R 1$: SUB TICMAX(SS),AR BLT 2$ INC R BR 1$ ; DIVIDE BY 100. 2$: MOVB R,(AD)+ ADD #20,SS RETURN ; ; ; ROUTINE DATE MOV (SS)+,AD JSR PC,GETTIM INC AD CNVRT #19. CNVRT YEAR(SS),#'- CNVRT MONTH(SS),#'- CNVRT DAY(SS) ADD #20,SS RETURN ; ; ; ROUTINE RUNTM JSR PC,GETTIM MOV HOUR(SS),AD BIC #177770,AD ; 8 HOUR INTERVALS JSR PC,MUL60 ADD MIN(SS),AD JSR PC,MUL60 ADD SEC(SS),AD ADD #20,SS MOV AD,-(SS) RETURN ; ; ; .END **** P11DEF.MAC .NLIST .NLIST BEX,TOC,SYM .IDENT /PAS6.3/ .PSECT PASRUN ; ; This assembly prefix file contains definitions and macros ; used by all runtime routines and by special macro routines ; of the compiler. ; ; SEVED TORSTENDAHL 1976-10-19 ; Gerry Pelletier 1984-12-30 ; ; ; ; The runtime support routines for Pascal are all assembled under ; psect PASRUN. ; ; All runtime support routines are called via a JSR R4 instruction ; either directly by Pascal programs or by other PASRUN routines. ; ; ; ; ; Local constants ; LUN1=1 LUN2=2 LUN3=3 LUN4=4 LUN5=5 LUN6=6 TILUN=5 ; ; MAXFILES=16. ; MAX NUMBER OF FILES BUFLEN=132. ; MAX RECORD SIZE FOR TEXT FILES ; FF=14 LF=12 CR=15 HT=11 SPC=40 ; FALSE=0 TRUE=1 ; ; ; ; Offsets for hidden global variables (GP relative offsets) ; LINEADDR=2 ; CURRENT STATEMENT LINENUMBER SELECTOR=4 ; DYNAMIC OPTION SWITCH WORD MARKADDR=6. ; MARKPOINTER DAPADDR =8. ; DYNAMIC AREA POINTER MARKDDT =10. ; MARKPOINTER USING DDT DAPDDT =12. ; LAST DEBUG ENTRY IN THE HEAP EXITP =14. ; POINTER TO EXIT ROUTINE HEAPBOT =16. ; ADDRESS OF FIRST WORD OF HEAP LUNTBL =18. ; LUN TABLE FOR PASCAL FILES ; ; ; ; Selector bit definitions ; WPRINT =1 ; V4-33 WCONT =2 SERCONT =4 MPRINT =10 SKIPSP =20 ; ; ; Error type codes ; WARNING =0 SERIOUS =1000 FATAL =400 MESSAGE =2000 ERPARM =100000 ; ; ; ; Register definitions ; AR =%0 ; GENERAL PURPOSE REGISTER R =%1 ; - '' - AD =%2 ; - '' - GP =%3 ; GLOBAL STACK FRAME BASE POINTER MP =%4 ; CURRENT STACK FRAME BASE POINTER SS =%5 ; SOFTWARE STACK HP =%6 ; HARDWARE STACK ; ; ; ; ; ; Definition of hidden part of file declaration ; FILESIZECORR =104. TEXTBUFFSIZE =132. FDBSIZE =96. FDB =-104. EOLNSTATUS =-8. EOFSTATUS =-6 IORESULT =-4 FILTYP =-2 ; ; ; Bit definitions for the IOSPEC parameter ; RANDOM =1 UPDATE =2 APPEND =4 TEMPORARY=10 INSERT =20 SHARED =40 SPOOL =100 BLKMODE =200 NOCR =400 FDFTN =1000 ; HIDDEN BITS GENERATE=10000 ; Generation file mode (dynamic) TTY =20000 TEXT =40000 INPUT =100000 ; ; ; ; ; Macro for subroutine call ; .MACRO CALLSS RTR,ENDRTR JSR MP,$'RTR .ENDM ; ; ; Macro for subroutine return ; .MACRO RETURN RTS MP .ENDM ; ; ; ; Macro for routine entry ; .MACRO ROUTINE RTR,ENDRTR $'RTR:: .ENDM ; Macro for SOB instruction ; Emulate SOB instruction for processsors that don't have it. ; .MACRO SOB R, L DEC R BNE L .ENDM ; ; ; ; Macro to retrieve and check FDB ; .MACRO FINDFILE WHERE,SSCORR,TTYIN,?L1,?L2 MOV WHERE,R MOV R,AR BIT #TTY,FILTYP(R) BNE L1 SUB #FILESIZECORR,AR TSTB F.LUN(AR) BNE L2 ; V4-33 MOV #TRUE,EOFSTATUS(R) MOV #-102.,IORESULT(R) .IIF NB ADD SSCORR,SS RETURN ; V4-33 L1: .IIF NB MOV TTYIN,R ; V4-33 L2: ; V4-33 .ENDM FINDFILE ; ; ; ; .LIST **** P11DFAULT.MAC .TITLE P11DFAULT .IDENT '800530' ; CHANGE GP-V6:22 1980-05-30 GP ; DEFAULT VALUES FOR SOME CONSTANTS ; $P.DEV =="SY ; DEFAULT DEVICE $P.UNI ==0 ; = SY0: ; $P.SEL ==3 ; THE SELECTOR WORD IS A BIT PATTERN ; GIVING THE RUNTIME BEHAVIOUR ; ; BIT MEANING IF 0 / 1 ; ; 1 DON'T PRINT / PRINT WARNINGS ; 2 STOP / CONTINUE AFTER WARNING ; 4 STOP / CONTINUE AFTER ERROR ; 10 DON'T PRINT / PRINT CONVERSION ERROR MESSAGES ; 20 DON'T SKIP / SKIP TRAILING BLANKS AFTER ; READING INTEGERS OR REALS ; ; .END **** P11DIF4.MAC .TITLE DIF4 ;****************************** DIF4 ********************************* ROUTINE DIF4 ENDDIF MOV SS, AD ;CALCULATE SET ADDRESSES IN SS AND AD ADD #8., AD ; BIC (SS)+,(AD)+ ;SET DIFFERENCE BIC (SS)+,(AD)+ BIC (SS)+,(AD)+ BIC (SS)+,(AD)+ ENDDIF: RTS MP .END **** P11DUMP.MAC .TITLE P11DMP .IDENT '810810' ;CHANGE GP-V6:72 1981-02-23 ; CHANGE GP-V6:86 1981-08-08 ; CHANGE GP-V6:88 1981-08-10 GP .MCALL SNPBK$, SNAP$ SNPBK$ SY,0,SC.LUN!SC.OVL!SC.HDR!SC.STK!SC.WRD!SC.BYT,31. D1: MOV #1.,-(HP) BR D D2: MOV #2.,-(HP) BR D D3: MOV #3.,-(HP) BR D D4: MOV #4.,-(HP) BR D D5: MOV #5.,-(HP) BR D D6: MOV #6.,-(HP) BR D D7: MOV #7.,-(HP) BR D D8: MOV #8.,-(HP) D: MOV #EX$ERR,-(SS) ; USE ERROR EXIT STATUS BR DD ROUTINE DUMP CLR -(HP) ; ZERO DUMP ID MOV #EX$SUC,-(SS) ; SUCCESSFUL EXIT STATUS DD: SNAP$ ,,(HP)+,HEAPBOT(GP),DAPADDR(GP),SS,-2(GP) JMP @EXITP(GP) $P.VEC::.WORD D1,D2,D3,D4,D5,D6,D7,D8 .END **** P11DVI.MAC .TITLE DIVI .IDENT '850807' ; CHANGE V6-108 1985-0807 GP ; ;***************************************** ;********** ********** ;********** NO EXTRA HARDWARE ********** ;********** ********** ;***************************************** ; ;****************************** DIVI ******************************** ; ; Integer Divide: ; ; Input: ; (SS) = denominator ; 2(SS) = numerator ; ; Output: ; (SS) = quotient ; ROUTINE DIVI ENDDIVI MOV (SS)+, AD ; Denominator in ad BNE DVI0 ; Test for denominator zero CLR (SS) ; Zero result after attemp to divide by 0 DVIL1: CALLSS WRERROR ; Print error message .BYTE 20. ; ERROR 20 .BYTE 1 ; Class of error: fatal RTS MP DVI0: MOV AD,-(HP) ; Stack denominator for sign BPL DVI2 ; Positive operands required NEG AD BVC DVI2 ; Test for most negative number CALLSS WRERROR .BYTE 21. ; ERROR 21 .BYTE 1 ; Class of error: fatal DVI2: MOV (SS), -(HP) ; For sign BPL DVI3 ; Invert sign if negative NEG (SS) DVI3: MOV #20, AR ; Count 16 TSTB 1(SS) ; Possibly faster? BNE DVI4 ; No ASR AR ; Yes, 8 is enough SWAB (SS) DVI4: CLR R ; Clear remainder DVI5: ASL (SS) ; Shift numerator ROL R CMP R, AD ; Remainder > denominator? BMI DVI9 ; No SUB AD, R ; Yes, subtract denom. INC (SS) ; Update quotient DVI9: DEC AR BGT DVI5 DVI6: TST (HP)+ ; Remove numerator from stack BMI DVI7 ; Sign test TST (HP)+ ; Remainder has the right sign ; Determine quotient sign BPL ENDDVI ; If den < 0 then quotient neg NEG (SS) RTS MP DVI7: TST (HP)+ ; Test denominator sign BMI DVI8 ; If denom. < 0 then quotient has right sign NEG (SS) DVI8: NEG R ENDDVI: RTS MP ;***************************** MODI ****************************** ; ; Standard Pascal MOD operator ; ; For i mod j it is an error if j is zero or negative otherwise ; the value of i mod j is that value of (i-(k*j)) for integral k ; such that 0 <= i mod j < j. (Note that i mod j is never negative.) ; ; Inputs: ; (SS) = j ; 2(SS) = i ; ; Output: ; (SS) = i mod j ; ROUTINE MODI MOV (SS), -(HP) ; Save j BPL 10$ ; If j is negative, then error CALLSS WRERROR .BYTE 22. ; ERROR 22 .BYTE 1 ; Class of error: fatal 10$: CALLSS DIVI ; Compute i div j MOV R,(SS) ; Load the remainder BPL 20$ ; Br if positive ADD (HP)+, (SS) ; Add j to negative remainder RTS MP 20$: TST (HP)+ ; Discard j RTS MP .END **** P11EISDVI.MAC .TITLE DIVI (P11EISDVI) .IDENT '850807' ; CORRECTION V4-20 1977-06-07 OEN ; CHANGE V6-108 1985-0807 GP ; ;********************************************** ;********** ********** ;********** E I S ********** ;********** ********** ;********** EXTENDED INSTRUCTION SET ********** ;********** ********** ;********************************************** ; ;****************************** DIVI ******************************** ; ; Integer Divide: ; ; Input: ; (SS) = denominator ; 2(SS) = numerator ; ; Output: ; (SS) = quotient ; ROUTINE DIVI ENDDIVI MOV (SS)+,AD BNE DVI1 CALLSS WRERROR ; Attempt to divide by zero .BYTE 20. ; Error code .BYTE 1 ; Error class: Fatal CLR (SS) ; Return zero CLR R ; and zero remainder BR ENDDVI DVI1: MOV (SS)+,R SXT AR ; Sign extend DIV AD,AR MOV AR,-(SS) ; Quotient ENDDVI: RTS MP ;***************************** MODI ****************************** ; ; Standard Pascal MOD operator ; ; For i mod j it is an error if j is zero or negative otherwise ; the value of i mod j is that value of (i-(k*j)) for integral k ; such that 0 <= i mod j < j. (Note that i mod j is never negative.) ; ; Inputs: ; (SS) = j ; 2(SS) = i ; ; Output: ; (SS) = i mod j ; ROUTINE MODI MOV (SS), -(HP) ; Save j BPL 10$ ; If j is negative, then error CALLSS WRERROR .BYTE 22. ; ERROR 22 .BYTE 1 ; Class of error: fatal 10$: CALLSS DIVI ; Compute i div j MOV R,(SS) ; Load the remainder BPL 20$ ; Br if positive ADD (HP)+, (SS) ; Add j to negative remainder RTS MP 20$: TST (HP)+ ; Discard j RTS MP .END **** P11EISMPI.MAC .TITLE MULI (P11EISMPI) ; ;********************************************** ;********** ********** ;********** E I S ********** ;********** ********** ;********** EXTENDED INSTRUCTION SET ********** ;********** ********** ;********************************************** ; ;****************************** SQI ********************************* ROUTINE SQI ENDSQI MOV (SS),R ;LOAD SECOND ARG FOR MULI MUL (SS),R MOV R,(SS) ENDSQI: RTS MP ;******************************* MULI ******************************** ROUTINE MULI ENDMULI MOV (SS)+, R ;R = FIRST OPERAND MUL (SS)+,R ; V4-4 MPI1: MOV R,-(SS) ;RESULT ON THE STACK ENDMPI: RTS MP .END **** P11EQU.MAC .TITLE EQU ;******************************* EQU ********************************** ROUTINE EQU ENDEQU CLR R ;BOOLEAN FALSE CMP (SS)+,(SS) ;COMPARE TWO ITEMS ON THE STACK BNE EQU0 ;NOT EQUAL --> FALSE INC R ;FALSE --> TRUE EQU0: MOV R, (SS) ;LOAD BOOLEAN RESULT ENDEQU: RTS MP .END **** P11EQUM.MAC .TITLE EQUM ; CORRECTION V6-1 1979-08-28 STD .IDENT /PAS601/ ;*************************** EQUM *************************** ROUTINE EQUM ENDEQM MOV (SS)+,AR ;SOURCE ADDRESS IN AR MOV (SS)+,AD ;DESTINATION ADDRESS IN AD MOV (MP)+, R ;LENGTH (IN WORDS) IN R ; V4-6 CALLSS EQUM2 ENDEQM: RTS MP ; ; ROUTINE EQUB ENDEQB MOV (SS)+, AR ;SOURCE ADDRESS IN AR MOV (SS)+, AD ;DESTINATION ADDRESS IN AD MOV (MP)+, R ;LENGTH ARGUMENT IN R CALLSS EQUB2 ENDEQB: RTS MP .END **** P11EQUM2.MAC .TITLE EQUM2 ; CORRECTION V6-1 1979-08-28 STD .IDENT /PAS601/ ;**************************** EQUM2 ************************** ROUTINE EQUM2 ENDEQ2 EQ20: CMP (AD)+,(AR)+ ;COMPARE WORDS OF SOURCE AND DESTINATION BNE EQ21 ;TEST COMPLETED IF NOT EQUAL DEC R ;DECREMENT WORD COUNT BGT EQ20 ;LOOP WHILE COUNT # 0 MOV #1,-(SS) ;LOAD BOOLEAN TRUE RTS MP EQ21: CLR -(SS) ;LOAD BOOLEAN FALSE ENDEQ2: RTS MP ; ; ROUTINE EQUB2 ENDEQB2 EQB20: CMPB (AD)+,(AR)+ ;COMPARE WORDS OF SOURCE AND DESTINATION BNE EQB21 DEC R ;DECREMENT WORD COUNT BGT EQB20 ;LOOP WHILE COUNT # 0 MOV #1,-(SS) ;LOAD BOOLEAN TRUE RTS MP EQB21: CLR -(SS) ;LOAD BOOLEAN FALSE ENDEQB2: RTS MP .END **** P11EQUS4.MAC .TITLE EQUS4 ;****************************** EQUS4 **************************** ROUTINE EQUS4 ENDQS4 MOV SS, AR ;SOURCE ADDRESS IN AR MOV SS, AD ADD #8., AD ;DESTINATION ADDRESS IN AD MOV #4, R ;LENGTH IN R CALLSS EQUM2 ; MOV (SS), 16.(SS) ;LOAD BOOLEAN RESULT ADD #16., SS ;REMOVE SETS ENDQS4: RTS MP .END **** P11EXIT.MAC .TITLE P11EXIT .IDENT '810816' ; CHANGE GP-V6:35 1980-05-31 GP ; CHANGE GP-V6:45 1980-06-24 GP ; CHANGE GP-V6:72 1981-02-23 GP ; CORRECTION GP-V6:86 1981-08-16 GP ; .MCALL EXIT$S, EXST$S ; ; ROUTINE EXITP ; (SS) - EXIT STATUS VALUE ; CLOSE ALL OPEN PASCAL FILES MOV #<2*MAXFILES>+2+LUNTBL,AD ; POINT AD ONE WORD BEYOND ADD GP,AD ; LUNTABLE MOV #MAXFILES+1,-(HP) ; NUMBER OF LUNTABLE ENTRIES 1$: TST -(AD) ; TEST LUNTABLE ENTRY BEQ 3$ ; BR IF FILE NOT OPEN BIT #1,(AD) BNE 3$ ; BR IF UNAVAILABLE TTY FILE MOV (AD),-(SS) 2$: CALLSS CLOSF ; CLOSE THE FILE 3$: DEC @HP BGT 1$ EXST$S (SS)+ ; EXIT WITH STATUS IF AVAILABLE EXIT$S ; ESLE PLAIN EXIT .END **** P11EXPSET.MAC .TITLE EXPSET ;***************************** EXPST ***************************** ROUTINE EXPST ENDEST MOV (SS), AR ;TEMPORARY STORAGE OF ONE WORD SET CLR (SS) ;CLEAR THREE TOP WORDS OF SET CLR -(SS) CLR -(SS) MOV AR,-(SS) ;COMPLETE FOUR WORD SET WITH FIRST WORD ENDEST: RTS MP ;***************************** EXPSN *************************** ROUTINE EXPSN ENDESN MOV SS, AR ;AR = ADDRESS OF SET ON TOP SUB #6, SS ;(SS) IS SMALL SET IN THE STACK MOV SS, AD ;AD = ADDRESS OF SMALL SET MOV (AR)+,(AD)+ ;SHIFT BOTH SETS THREE PLACES IN THE STACK MOV (AR)+,(AD)+ MOV (AR)+,(AD)+ MOV (AR)+,(AD)+ MOV (AR),(AD)+ CLR (AR) ;CLEAR THREE TOP WORDS OF EXPANDED SET CLR -(AR) CLR -(AR) ENDESN: RTS MP .END **** P11EXST.MAC .TITLE P11EXST ; USER CALLABLE EXIT WITH STATUS ROUTINE ; ; ; PROCEDURE EXITST ( EXITSTATUS: INTEGER ); EXTERN; ; EXITST:: TST (SS)+ ; DISCARD LINK JMP @EXITP(GP) ; JUMP TO EXIT ROUTINE .END **** P11FIS.MAC .TITLE P11RAR (P11FIS) REAL ARITHMETIC SUBROUTINES .IDENT '800601' ; CORRECTION V4-17 1977-06-23 STD ; CHANGE GP-V6-30 1980-06-01 GP ; ;********************************************** ;********** ********** ;********** F I S ********** ;********** ********** ;********** FLOATING INSTRUCTION SET ********** ;********** ********** ;********************************************** ; ; FOR PDP-11'S WITH FIS, FLOATING INSTRUCTION SET ;************************** SCALE **************************** ;R0 CONTAINS SIGN FLAG: R0 = 0 --> PLUS OR ZERO, R0 = -1 --> MINUS ;RAW DECIMAL EXPONENT IN R2 ;AFTER EXECUTION: R0 UNCHANGED, R2 = 0 ROUTINE SCALE ENDSCL SCL0: TST R2 ;ZERO? BEQ SCL6 ;YES, READY CMP R2, #11. ;DECEXP >=10? BPL SCL2 DEC R2 ASL R2 ASL R2 MOV R2, R1 ;FIND POWER TABLE ENTRY CLR R2 ;AND SAVE R2 ADD PC, R1 ;BASE ADDRESS BZX1: ADD #TENPOW+4-BZX1, R1 ;TENPOWERS BR SCL3 SCL2: SUB #10., R2 ;DECREMENT DECEXP BY TEN MOV PC, R1 ;BASE ADDRESS BZX2: ADD #TENPWO+4-BZX2, R1 ;FLOATING E10 SCL3: MOV -(R1),-(SS) MOV -(R1),-(SS) ;LOAD TENPOWERS MOV R2,-(HP) ;STORE DECEXP MOV R0,-(HP) ;STORE R0 BPL SCL4 ;BRANCH IF PLUS --> DIVIDE CALLSS MULR ;MULTIPLY BR SCL5 SCL4: CALLSS DIVR SCL5: MOV (HP)+, R0 MOV (HP)+, R2 ;RESTORE REGISTERS BR SCL0 ;TRY AGAIN SCL6: RTS MP TENPOW: .FLT2 1E1 .FLT2 1E2 .FLT2 1E3 .FLT2 1E4 .FLT2 1E5 .FLT2 1E6 .FLT2 1E7 .FLT2 1E8 .FLT2 1E9 TENPWO: .FLT2 1E10 ;TABLE OF TENPOWERS ENDSCL=.-2 ;********************************** RND *************************** ;ADDS 0.5 TO THE REAL IN (SS), 2(SS) BEFORE TRUNCATION ROUTINE RND ENDRND CLR -(SS) MOV #40000, -(SS) ;LOAD REAL VALUE 0.5 BIT #100000,4(SS) ; V4-13 BEQ RND1 ; V4-13 BIS #100000,(SS) ; SET CORRECT SIGN ; V4-13 RND1: CALLSS ADDR ;ADD ; V4-13 CALLSS TRC ;TRUNCATE ENDRND: RTS MP ;******************************* TRC **************************** ;EXPECTS A REAL AT (SS), 2(SS). LEAVES AN INTEGER AT (SS) ;REGISTER USE: R0, R1, AND R2 ROUTINE TRC ENDTRC CALLSS EXPTOP ;RETURNS R1=EXP, R0=SIGN CLR R2 ;CLEAR RESULT TST R1 BLE TRC2 ;EXP <=0 --> RESULT = 0 CMP R1, #16. ;EXP TOO LARGE? BLT TRC3 ;NO CALLSS WRERROR .BYTE 33.,1 BR TRC2 TRC3: ASL 2(R5) ;SHIFT ROL (R5) ROL R2 ;COMPOSE INTEGER DEC R1 BGT TRC3 ;LOOP MOVB R2, (R5) ;MOVE SECOND BYTE SWAB (R5) ;SWAP BYTES MOV (R5), R2 ;RESULT IN R2 TST R0 BEQ TRC2 ;INTEGER > 0? NEG R2 TRC2: CMP (R5)+,(R5)+ MOV R2,-(SS) ENDTRC: RTS MP ;************************** SQRR ****************************** ROUTINE SQRR ENDSQR MOV 2(SS),-(SS) ;COPY THE REAL ON TOP OF THE STACK MOV 2(SS),-(SS) ; CALLSS MULR ENDSQR: RTS MP ;******************************* ADDR ******************************* ;REALS ARE EXPECTED AT (R5),2(R5) AND 4(R5),6(R5) ;SS INCREMENTED BY 4 AFTER RETURN ;REGISTERS USED: R0, R1, R2, AND R5 (=SS) R0 = %0 R1 = %1 R2 = %2 R5 = %5 ROUTINE ADDR ENDADDR FADD R5 ENDADR: RTS MP ;******************************* MULR ***************************** ROUTINE MULR ENDMPR FMUL R5 ENDMPR: RTS MP ;***************************** SIGNS ****************************** ;REGISTER USE: R0 ONLY ;R2, R0 ARE PASSED TO NORM ROUTINE SIGNS ENDSGN TST R0 BEQ SGN0 ;BOTH 'PLUS' ASL R0 CMP R0, #1002 BEQ SGN0 ;BOTH 'MINUS' MOV #1, R0 SGN0: CALLSS NORM ;NORMALIZE REAL ENDSGN: RTS MP ;******************************** SUBR **************************** ROUTINE SUBR ENDSUBR FSUB R5 ENDSBR: RTS MP ;*************************** DIVR ***************************** ROUTINE DIVR ENDDIVR TST 4(R5) BEQ DVR1 ;ZERO? --> NOTHING TO DO TST (R5) ;DENOMINATOR ZERO? BNE DVR2 ;NO, GO ON CALLSS WRERROR .BYTE 34.,1 ;ZERO DIVISION DVR1: CMP (R5)+,(R5)+ ;REMOVE SECOND REAL CLR 2(R5) ;ZERO RESULT RTS MP DVR2: FDIV R5 ENDDVR: RTS MP ; ; V4-17 ;******************************* EXPTOP ***************************** ;EXPECTS A REAL AT (R5), 2(R5). ;SIGN AND EXPONENT ARE TAKEN FROM THE REAL AND STORED ;IN R0 AND R1. REAL FRACTION IS LEFT AT (R5), 2(R5) ROUTINE EXPTOP ENDXPT CLR R0 ;CLEAR SIGNS MOV (R5), R1 ASL R1 ROL R0 ; PUT SIGN IN R0 HIGH BYTE ; GP-V6:30 SWAB R0 ; GP-V6:30 CLRB R1 SWAB R1 ;EXPONENT OF SECOND REAL SUB #200, R1 ;PURE EXPONENT CLRB 1(R5) BIS #200, (R5) ;HIDDEN BIT ENDXPT: RTS MP ;***************************** EXPNTOP *************************** ;EXPECTS A REAL AT 4(R5), 6(R5) ;SIGN AND EXPONENT ARE RETURNED IN R0 AND R2 ;REAL FRACTION LEFT AT 4(R5), 6(R5) ROUTINE EXPNTOP ENDXPN MOV 4(R5), R2 ASL R2 ADC R0 ;SIGN OF DESTINATION CLRB R2 SWAB R2 ;EXPONENT SUB #200, R2 CLRB 5(R5) BIS #200, 4(R5) ;HIDDEN BIT ENDXPN: RTS MP ; ; V4-17 ;********************************* FLT **************************** ;REGISTERS USED: R0, R1, R2 ROUTINE FLT ENDFLT CLR R0 ;INIT SIGN REGISTER MOV (SS),-(SS) ;MOVE ONE PLACE BGT FLT1 ;TEST VALUE BEQ ENDFLT NEG (SS) ;NEGATE INTEGER INC R0 ;SIGN < 0 FLT1: MOV #10,R2 ;EXPONENT FLT2: CLR 2(SS) ;CLEAR SECOND WORD CLR R1 ;NO CARRY BIT CALLSS NORM ;NORMALIZE REAL ENDFLT: RTS MP ;******************************* FLO *************************** ROUTINE FLO ENDFLO MOV (SS)+,-(HP) MOV (SS)+,-(HP) ;STORE REAL ON TOP CALLSS FLT ;FLOAT INTEGER ON TOP MOV (HP)+,-(SS) MOV (HP)+,-(SS) ;RESTORE REAL ENDFLO: RTS MP ;*************************** NORM ****************************** ;(NOT NORMALIZED) REAL FRACTION EXPECTED AT (R5), 2(R5) ;BINARY EXPONENT IN R2, SIGN IN R0. R1 CONTAINS CARRY BIT. ;A NORMALIZED REAL IS LEFT IN (R5), 2(R5) ROUTINE NORM ENDNRM ADD #200, R2 ;EXCESS 200 TST (R5) ;FRACTION ZERO? BNE NRM1 ;NO TST 2(R5) ;MAYBE BEQ NRM7 ;YES NRM1: CMP (R5), #400 ;FRACTION OVERFLOW? BPL NRM3 ;YES. NRM2: CMP (R5), #200 ;NORMALIZED? BPL NRM4 ASL R1 ;GET CARRY BIT ROL 2(R5) ;SCALE ROL (R5) ;LEFT DEC R2 ;ADJUST EXPONENT BR NRM2 ;GO AGAIN NRM3: ASR (R5) ;SCALE ROR 2(R5) ;RIGHT ROR R1 ;STORE CARRY BIT INC R2 BR NRM1 NRM4: ASL R1 BCC NRM8 ADC 2(R5) ADC (R5) CLR R1 BR NRM1 ;RETURN FOR NEXT TRY NRM8: CMP R2, #377 ;EXPONENT OVERFLOW? BLE NRM5 ;NO CALLSS WRERROR .BYTE 30.,2 MOV #-1,(R5) MOV (R5),2(R5) ;BIGGEST ABSOLUTE VALUE ASR R0 ROR (R5) ;SIGN RTS MP NRM5: TST R2 ;EXPONENT UNDERFLOW? BPL NRM6 ;NO CALLSS WRERROR .BYTE 31.,2 CLR (R5) CLR 2(R5) ;FLOATING ZERO RTS MP NRM6: BICB #200,(R5) ;REMOVE SIGNIFICANT BIT SWAB R2 ASR R0 ;SIGN ROR R2 ;RIGHT POSITION BIS R2,(R5) ;PACK EXPONENT NRM7: ENDNRM: RTS MP .END **** P11FORFPP.MAC .TITLE FORTR (P11FORFPP.MAC) .IDENT '800625' ; ; INTERFACE TO FORTRAN ROUTINES ; ROUTINE FORTR MOV (SS)+,AR ; NO OF PARAMS + 1 DEC AR BEQ 2$ MOV AR,R MOV SS,AD 1$: MOV (AD)+,-(SS) ; REVERSE ORDER OF PARAMS DEC R BGT 1$ 2$: MOV AR,-(SS) ; NO OF PARAMS MOV (MP)+,AD ; RELATIVE ADDR OF ROUTINE ADD MP,AD MOV MP,-(HP) ; SAVE R3 - R5 AND FLOATING POINT STATUS MOV SS,-(HP) MOV GP,-(HP) STFPS -(HP) MOV DAPADDR(GP),$OTSV ; FORTRAN OTS CONTEXT SAVE/PTR JSR PC,@AD LDFPS (HP)+ ; RESTORE FLOATING POINT STATUS MOV (HP)+,GP ; RESTORE R3 - R5 MOV (HP)+,SS MOV (HP)+,MP MOV (SS)+,AD ; NO OF PARAMS ASL AD ASL AD ADD AD,SS ; SKIP ALL PARAMETERS RETURN ; .END **** P11FORTR.MAC .TITLE FORTR ; ; INTERFACE TO FORTRAN ROUTINES ; ROUTINE FORTR MOV (SS)+,AR ; NO OF PARAMS + 1 DEC AR BEQ 2$ MOV AR,R MOV SS,AD 1$: MOV (AD)+,-(SS) ; REVERSE ORDER OF PARAMS DEC R BGT 1$ 2$: MOV AR,-(SS) ; NO OF PARAMS MOV (MP)+,AD ; RELATIVE ADDR OF ROUTINE ADD MP,AD MOV MP,-(HP) ; SAVE R3 - R5 MOV SS,-(HP) MOV GP,-(HP) MOV DAPADDR(GP),$OTSV ; FORTRAN OTS CONTEXT SAVE/PTR JSR PC,@AD MOV (HP)+,GP ; RESTORE R3 - R5 MOV (HP)+,SS MOV (HP)+,MP MOV (SS)+,AD ; NO OF PARAMS ASL AD ASL AD ADD AD,SS ; SKIP ALL PARAMETERS RETURN ; .END **** P11FPP.MAC .TITLE P11RAR (P11FPP) REAL ARITHMETIC SUBROUTINES ; CORRECTION V4-17 1977-06-23 STD ; CORRECTION V4-41 1977-08-16 OEN ; ;********************************************** ;********** ********** ;********** F P P ********** ;********** ********** ;********** FLOATING POINT PROCESSOR ********** ;********** ********** ;********************************************** ; AC0=%0 AC1=%1 AC2=%2 AC3=%3 AC4=%4 AC5=%5 ; ; FOR PDP-11'S WITH FPP, FLOATING POINT PROCESSOR ;************************** SCALE **************************** ;R0 CONTAINS SIGN FLAG: R0 = 0 --> PLUS OR ZERO, R0 = -1 --> MINUS ;RAW DECIMAL EXPONENT IN R2 ;AFTER EXECUTION: R0 UNCHANGED, R2 = 0 ROUTINE SCALE ENDSCL SCL0: TST R2 ;ZERO? BEQ SCL6 ;YES, READY CMP R2, #11. ;DECEXP >=10? BPL SCL2 DEC R2 ASL R2 ASL R2 MOV R2, R1 ;FIND POWER TABLE ENTRY CLR R2 ;AND SAVE R2 ADD PC, R1 ;BASE ADDRESS BZX1: ADD #TENPOW+4-BZX1, R1 ;TENPOWERS BR SCL3 SCL2: SUB #10., R2 ;DECREMENT DECEXP BY TEN MOV PC, R1 ;BASE ADDRESS BZX2: ADD #TENPWO+4-BZX2, R1 ;FLOATING E10 SCL3: MOV -(R1),-(SS) MOV -(R1),-(SS) ;LOAD TENPOWERS MOV R2,-(HP) ;STORE DECEXP MOV R0,-(HP) ;STORE R0 BPL SCL4 ;BRANCH IF PLUS --> DIVIDE CALLSS MULR ;MULTIPLY BR SCL5 SCL4: CALLSS DIVR SCL5: MOV (HP)+, R0 MOV (HP)+, R2 ;RESTORE REGISTERS BR SCL0 ;TRY AGAIN SCL6: RTS MP TENPOW: .FLT2 1E1 .FLT2 1E2 .FLT2 1E3 .FLT2 1E4 .FLT2 1E5 .FLT2 1E6 .FLT2 1E7 .FLT2 1E8 .FLT2 1E9 TENPWO: .FLT2 1E10 ;TABLE OF TENPOWERS ENDSCL=.-2 ;********************************** RND *************************** ;ADDS 0.5 TO THE REAL IN (SS), 2(SS) BEFORE TRUNCATION ROUTINE RND ENDRND CLR -(SS) MOV #40000, -(SS) ;LOAD REAL VALUE 0.5 BIT #100000,4(SS) ; V4-13 BEQ RND1 ; V4-13 BIS #100000,(SS) ; SET CORRECT SIGN ; V4-13 RND1: CALLSS ADDR ;ADD ; V4-13 CALLSS TRC ;TRUNCATE ENDRND: RTS MP ;******************************* TRC **************************** ;EXPECTS A REAL AT (SS), 2(SS). LEAVES AN INTEGER AT (SS) ;REGISTER USE: R0, R1, AND R2 ROUTINE TRC ENDTRC LDF (SS)+,AC0 ; GET FLOATING ; V4-41 STCFI AC0,-(SS) ; CONVERT AND STORE ; V4-41 ENDTRC: RTS MP ;************************** SQRR ****************************** ROUTINE SQRR ENDSQR MOV 2(SS),-(SS) ;COPY THE REAL ON TOP OF THE STACK MOV 2(SS),-(SS) ; CALLSS MULR ENDSQR: RTS MP ;******************************* ADDR ******************************* ;REALS ARE EXPECTED AT (R5),2(R5) AND 4(R5),6(R5) ;SS INCREMENTED BY 4 AFTER RETURN ;REGISTERS USED: R0, R1, R2, AND R5 (=SS) R0 = %0 R1 = %1 R2 = %2 R5 = %5 ROUTINE ADDR ENDADDR LDF (SS)+,AC0 ADDF (SS)+,AC0 STF AC0,-(SS) ENDADR: RTS MP ;******************************* MULR ***************************** ROUTINE MULR ENDMPR LDF (SS)+,AC0 MULF (SS)+,AC0 STF AC0,-(SS) ENDMPR: RTS MP ;***************************** SIGNS ****************************** ;REGISTER USE: R0 ONLY ;R2, R0 ARE PASSED TO NORM ROUTINE SIGNS ENDSGN TST R0 BEQ SGN0 ;BOTH 'PLUS' ASL R0 CMP R0, #1002 BEQ SGN0 ;BOTH 'MINUS' MOV #1, R0 SGN0: CALLSS NORM ;NORMALIZE REAL ENDSGN: RTS MP ;******************************** SUBR **************************** ROUTINE SUBR ENDSUBR LDF (SS)+,AC0 SUBF (SS)+,AC0 NEGF AC0 STF AC0,-(SS) ENDSBR: RTS MP ;*************************** DIVR ***************************** ROUTINE DIVR ENDDIVR TST 4(R5) BEQ DVR1 ;ZERO? --> NOTHING TO DO TST (R5) ;DENOMINATOR ZERO? BNE DVR2 ;NO, GO ON CALLSS WRERROR .BYTE 34.,1 ;ZERO DIVISION DVR1: CMP (R5)+,(R5)+ ;REMOVE SECOND REAL CLR 2(R5) ;ZERO RESULT RTS MP DVR2: LDF (SS)+,AC1 ; V4-41 LDF (SS)+,AC0 ; V4-18, -41 DIVF AC1,AC0 ; V4-41 STF AC0,-(SS) ; V4-41 ENDDVR: RTS MP ; ; V4-17 ;******************************* EXPTOP ***************************** ;EXPECTS A REAL AT (R5), 2(R5). ;SIGN AND EXPONENT ARE TAKEN FROM THE REAL AND STORED ;IN R0 AND R1. REAL FRACTION IS LEFT AT (R5), 2(R5) ROUTINE EXPTOP ENDXPT CLR R0 ;CLEAR SIGNS MOV (R5), R1 ASL R1 ROL R0 ; PUT SIGN IN R0 HIGH BYTE ; GP-V6:30 SWAB R0 ; GP-V6:30 CLRB R1 SWAB R1 ;EXPONENT OF SECOND REAL SUB #200, R1 ;PURE EXPONENT CLRB 1(R5) BIS #200, (R5) ;HIDDEN BIT ENDXPT: RTS MP ;***************************** EXPNTOP *************************** ;EXPECTS A REAL AT 4(R5), 6(R5) ;SIGN AND EXPONENT ARE RETURNED IN R0 AND R2 ;REAL FRACTION LEFT AT 4(R5), 6(R5) ROUTINE EXPNTOP ENDXPN MOV 4(R5), R2 ASL R2 ADC R0 ;SIGN OF DESTINATION CLRB R2 SWAB R2 ;EXPONENT SUB #200, R2 CLRB 5(R5) BIS #200, 4(R5) ;HIDDEN BIT ENDXPN: RTS MP ; ; V4-17 ;********************************* FLT **************************** ;REGISTERS USED: R0, R1, R2 ROUTINE FLT ENDFLT LDCIF (SS)+,AC0 ; LOAD INT & CONV ; V4-41 STF AC0,-(SS) ; STORE ; V4-41 ENDFLT: RTS MP ;******************************* FLO *************************** ROUTINE FLO ENDFLO MOV (SS)+,-(HP) MOV (SS)+,-(HP) ;STORE REAL ON TOP CALLSS FLT ;FLOAT INTEGER ON TOP MOV (HP)+,-(SS) MOV (HP)+,-(SS) ;RESTORE REAL ENDFLO: RTS MP ;*************************** NORM ****************************** ;(NOT NORMALIZED) REAL FRACTION EXPECTED AT (R5), 2(R5) ;BINARY EXPONENT IN R2, SIGN IN R0. R1 CONTAINS CARRY BIT. ;A NORMALIZED REAL IS LEFT IN (R5), 2(R5) ROUTINE NORM ENDNRM ADD #200, R2 ;EXCESS 200 TST (R5) ;FRACTION ZERO? BNE NRM1 ;NO TST 2(R5) ;MAYBE BEQ NRM7 ;YES NRM1: CMP (R5), #400 ;FRACTION OVERFLOW? BPL NRM3 ;YES. NRM2: CMP (R5), #200 ;NORMALIZED? BPL NRM4 ASL R1 ;GET CARRY BIT ROL 2(R5) ;SCALE ROL (R5) ;LEFT DEC R2 ;ADJUST EXPONENT BR NRM2 ;GO AGAIN NRM3: ASR (R5) ;SCALE ROR 2(R5) ;RIGHT ROR R1 ;STORE CARRY BIT INC R2 BR NRM1 NRM4: ASL R1 BCC NRM8 ADC 2(R5) ADC (R5) CLR R1 BR NRM1 ;RETURN FOR NEXT TRY NRM8: CMP R2, #377 ;EXPONENT OVERFLOW? BLE NRM5 ;NO CALLSS WRERROR .BYTE 30.,2 MOV #-1,(R5) MOV (R5),2(R5) ;BIGGEST ABSOLUTE VALUE ASR R0 ROR (R5) ;SIGN RTS MP NRM5: TST R2 ;EXPONENT UNDERFLOW? BPL NRM6 ;NO CALLSS WRERROR .BYTE 31.,2 CLR (R5) CLR 2(R5) ;FLOATING ZERO RTS MP NRM6: BICB #200,(R5) ;REMOVE SIGNIFICANT BIT SWAB R2 ASR R0 ;SIGN ROR R2 ;RIGHT POSITION BIS R2,(R5) ;PACK EXPONENT NRM7: ENDNRM: RTS MP .END **** P11FPPINI.MAC .TITLE P11FPPINI .IDENT '840330' ; CHANGE GP-V6:102 84-03-30 GP .MCALL SFPA$S, ASTX$S ROUTINE FPINI ; Initialize floating point processor SFPA$S #FLTAST ; SPECIFY FPP AST ROUTINE BCC 10$ ; BR IF NO ERROR ; If carry bit is set then the most likely cause is that the task was ; not built with the /FP switch. ; ; It is important to check here that the task was built with the /FP switch. ; If it was not then the OS will not save the floating point context ; during a task context switch. This could cause the disastrous ; corruption of current floating calculations. CALLSS WRERROR .WORD 13.+FATAL ; Declare fatal error 10$: LDFPS #7400 ; ENABLE UNDERFLOW, OVERFLOW, ; CONVERSION AND "-0" ERROR INTERRUPT SETI ; SET FPP TO SHORT INTEGER SETF ; SET FPP TO SHORT FLOATING RETURN AC0=%0 ; FLOATING POINT PROCESSOR AST ROUTINE IS ENTERED ; UPON ERRORS DETECTED BY THE FPP HARDWARE ; ; IT IS ASSUMED THAT FLOATING AC 0 IS USED FOR ; RESULT OF ALL FLOATING OPERATIONS ; ; ; INPUT (HP) ADDRESS OF FPP INSTRUCTION ; 2(HP) FLOATING EXCEPTION CODE ; MAXR: .FLT2 1.7014117E38 ;MAXREAL ASTTBL: .WORD ASTEND .WORD ASTEND .WORD ASTEND .WORD CNVERR .WORD OVERFL .WORD UNDERFL .WORD MINUS0 .WORD ASTEND ; FLTAST: TST (HP)+ ; REMOVE FEA ADD #ASTTBL,(HP) ; ADD TABLE ADDR TO INDEX MOV @HP,R0 JMP @(R0) ; USE AS POINTER ; CNVERR: CALLSS WRERROR .WORD 33.+FATAL ; FLT TO INTEGER ; ZERO RETURNED BY HARDWARE BR ASTEND OVERFL: CALLSS WRERROR .WORD 30.+WARNING LDF MAXR,AC0 ; RETURN MAXREAL BR ASTEND UNDERFL: CALLSS WRERROR .WORD 31.+WARNING MINUS0: CLRF AC0 ; RETURN ZERO ASTEND: TST (HP)+ ; REMOVE FEC ASTX$S ; RETURN FROM AST .END **** P11FREQV.MAC .TITLE $P.FRQ .IDENT '800624' ; CORRECTION GP-V6:45 1980-06-24 GP ROUTINE P.FRQ MOV LUNTBL+2(GP),-(SS) ; ADDR OF FILE OUTPUT BEQ 9$ MOV #6,R0 ; FETCH FILE NAME 1$: MOV (MP)+,-(SS) ; AND LINE ELEMENT POINTER DEC R0 BGT 1$ MOV R3,-(SS) ; LINK CALL PASFQV RETURN ; 9$: ADD #12.,MP ; SKIP FILE NAME & LINE ELEM RETURN ; ; .END  **** P11GCML.MAC .TITLE GCML ; .MCALL GMCR$,DIR$ ; CML: GMCR$ ; ; ; ; TYPE LINEBUFF = ARRAY [1..80] OF CHAR ; ; PROCEDURE GCML( LINE: LINEBUFF; LEN: INTEGER ) ; ; LINE =4 LEN =2 ; GCML:: DIR$ #CML MOV $DSW,@LEN(SS) MOV LINE(SS),AD TSTB (AD)+ ; LOW LIMIT = 1 MOV $DSW,R MOV #CML+2,AR 1$: MOVB (AR)+,(AD)+ DEC R BGT 1$ ADD #LINE+2,SS RTS PC ; ; .END **** P11GEQ.MAC .TITLE GEQ ;***************************** GEQ ************************************ ROUTINE GEQ ENDGEQ CLR R CMP (SS)+,(SS) BGT GEQ0 INC R GEQ0: MOV R, (SS) ENDGEQ: RTS MP .END **** P11GEQM.MAC .TITLE GEQM ;**************************** GEQM ************************ ROUTINE GEQM ENDGQM MOV (SS)+, AR ;LOAD SOURCE ADDRESS IN AR MOV (SS)+, AD ;LOAD DESTINATION ADDRESS IN AD MOV (MP)+, R ;FETCH LENGTH ARGUMENT CALLSS GEQM2 ENDGQM: RTS MP .END **** P11GEQM2.MAC .TITLE GEQM2 ;************************* GEQM2 ***************************** ROUTINE GEQM2 ENDGQ2 GQ20: CMPB (AD)+,(AR)+ ;COMPARE BYTES OF SOURCE AND DESTINATION BNE GQ21 ;TEST RELATION IF NOT EQUAL DEC R ;DECREMENT BYTE COUNTER BGT GQ20 ;LOOP WHILE COUNT # 0 GQ22: MOV #1,-(SS) ;LOAD BOOLEAN TRUE RTS MP GQ21: BGT GQ22 ;IF GREATER THEN RESULT = TRUE CLR -(SS) ;LOAD BOOLEAN FALSE ENDGQ2: RTS MP .END **** P11GEQS1.MAC .TITLE GEQS1 ;******************************* GEQS1 ***************************** ROUTINE GEQS1 ENDGS1 CLR R ;BOOLEAN FALSE MOV (SS)+, AR ;AR CONTAINS SET BIS (SS), AR ;SET UNION CMP (SS), AR ;COMPARE BNE GS10 INC R ;FALSE --> TRUE GS10: MOV R,(SS) ;LOAD BOOLEAN ENDGS1: RTS MP .END **** P11GEQS4.MAC .TITLE GEQS4 ;******************************** GEQS4 **************************** ROUTINE GEQS4 ENDGS4 MOV SS, AR ;AR = ADDRESS OF SET MOV SS, AD ADD #8., AD ;ADDRESS OF SECOND SET CLR -(SS) ;INITIALIZE BOOLEAN RESULT MOV #4, R ;LENGTH IN WORDS GS40: BIS (AD),(AR) ;SET UNION CMP (AD)+,(AR)+ ;COMPARE IF EQUAL BNE GS41 DEC R ;DECREMENT WORD COUNT BGT GS40 ;LOOP INC (SS) ;BOOLEAN TRUE GS41: MOV (SS), 16.(SS) ;LOAD BOOLEAN RESULT ADD #16.,SS ;REMOVE SETS ENDGS4: RTS MP .END **** P11GETPUT.MAC .TITLE P11GETPUT .IDENT '850807' ; CORRECTION V4-15 1977-06-22 STD ; CORRECTION V4-24 1977-07-25 OEN ; CORRECTION V4-27 1977-08-12 STD ; CORRECTION V4-36 1977-08-12 STD ; CORRECTION V4-37 1977-08-12 STD ; CORRECTION V4-47 1977-10-12 STD ; CORRECTION V4-49 1977-10-12 STD ; CORRECTION V5-35 1979-06-01 STD ; CORRECTION GP-V6:19 80-05-30 GP (810808) ; CORRECTION GP-V6:25 80-05-30 GP ; CORRECTION GP-V6:33 80-05-30 GP ; CORRECTION GP-V6:36 80-05-30 GP ; CORRECTION GP-V6:45 80-07-08 GP ; CORRECTION GP-V6:48 80-06-29 GP ; CORRECTION GP-V6:56 80-08-06 GP ; CORRECTION GP-V6:103 84-12-30 GP ; CHANGE GP-V6:109 85-08-07 GP ; ; .MCALL GET$,PUT$,QIO$S,WTSE$S,FDOF$L,FSRSZ$ ; FDOF$L ; DEFINE FDB OFFSETS ; Allocation of block buffers will be done by task builder ; by extending the FSR Psect through the ACTFIL option. ; FSRSZ$ 0 ; V5-35 ; .PSECT PASRUN ; ;====================================================================== ; ; ; WRREC Write a record to Pascal file ; 2(SS) = file ; (SS) = record address ; ROUTINE WRREC ; MOV (SS)+,AD FINDFILE @SS MOV @R,R MOV F.RSIZ(AR),-(SS) ; Record size INC @SS ASR @SS ; Word size 1$: MOV (AD)+,(R)+ DEC @SS BGT 1$ TST (SS)+ ; Skip counter MOV @SS,R ; File BR $PUT2 ; -1 GP-V6:33 ; ;====================================================================== ; ; PUT(F) Pascal file put procedure ; ; (SS) = pointer to file window ; ROUTINE PUT FINDFILE (SS)+ BIT #TEXT,FILTYP(R) BNE PUTCH1 BIT #GENERATE,FILTYP(R) ; If file is not in generation BNE 8$ ; mode and the current record CMP F.RCNM+2(AR),#1 ; number is not 1 then decrement BNE 7$ ; the record number so we will TST F.RCNM(AR) ; put into the last record accessed BEQ 8$ ; by get. Note that this only 7$: SUB #1,F.RCNM+2(AR) ; has effect if the file was SBC F.RCNM(AR) ; open for random access. 8$: $PUT2:: PUT$ BIS #GENERATE,FILTYP(R) ; Set generation mode MOV F.NRBD+2(AR),@R ; Next record buffer MOVB F.ERR(AR),AD ; Error byte MOV AD,IORESULT(R) ; Sign extended result 9$: RETURN PUTCH1: INC @R DEC 2(R) BLE PUTLN2 MOV #1,IORESULT(R) RETURN ; ;====================================================================== ; ; PUTLN (F) Pascal writeln (F) ; ; (SS) = POINTER TO FILE WINDOW ; ROUTINE PUTLN FINDFILE (SS)+ ROUTINE PUTL2 ; GP-V6:56 PUTLN2: BIT #TTY,FILTYP(R) BNE PUTTTY MOV #TEXTBUFFSIZE,AD SUB 2(R),AD ; = number of char on current line PUT$ ,,AD MOV #TEXTBUFFSIZE,2(R) MOV F.NRBD+2(AR),@R ; Next record buffer pointer MOVB F.ERR(AR),AD MOV AD,IORESULT(R) RETURN ; ;====================================================================== ; ; BREAK Forces output of current text file line. ; For TTY file, cursor stays at end of line. ; ; (SS) = FILE POINTER ; ROUTINE BRKLN $BRK:: FINDFILE (SS)+ BIT #TTY,FILTYP(R) BEQ PUTLN2 MOV #44,AR ; Carriage control char BR BRK2 ; PUTTTY: MOV #40,AR ; Carriage control char BRK2: MOV R,AD SUB #FILESIZECORR+TEXTBUFFSIZE-FDBSIZE,AD SUB AD,@R BNE 10$ ; If nothing to output then ; GP-V6:25 CLRB (AD) ; output a null ; GP-V6:25 INC @R ; to get a blank line ; GP-V6:25 10$: ; GP-V6:25 CMP -(SS),-(SS) ; Space for IO status block QIO$S #IO.WVB,#TILUN,#5,,SS,, WTSE$S #5 MOV AD,@R MOV #TEXTBUFFSIZE,2(R) MOVB @SS,AD CMP (SS)+,(SS)+ ; Remove IO status block MOV AD,IORESULT(R) RETURN ; ;====================================================================== ; ; WRCHA (F,CHAR:N) Write character with field width to text file ; ; 2(SS) = CHARACTER ; (SS) = FIELDLENGTH ; ROUTINE WRCHA CLR AD MOV #1,-(SS) ; String length BR WRS1 ; ;====================================================================== ; ; WRC (F,CHAR) Write character to text file (no field width) ; ; 2(SS) = POINTER TO FILE WINDOW ; (SS) = CHARACTER ; ROUTINE WRC MOV (SS)+,R ; Get char MOV @SS,AD ; Get file pointer MOVB R,@(AD)+ ; Put char in file window MOV (SS),-(SS) ; Leave file pointer on stack JMP $PUT ; ;====================================================================== ; ; WRS (F,STRING) Write string to text file ; ; 6(SS) = POINTER TO FILE WINDOW ; 4(SS) = ADDRESS OF STRING ; 2(SS) = FIELDLENGTH ; (SS) = LENGTH OF STRING ; ROUTINE WRS MOV GP,AD ; <> ZERO WRS1: FINDFILE 6(SS),#6. ; V4-24 MOV AD,-(HP) ; WRCHA or WRS CMP (SS),2(SS) ; BLE 6$ ; str.len <= fieldwidth MOV 2(SS),(SS) ; fieldwidth := min(str.len,fieldwidth) 6$: MOV (SS)+,-(HP) ; Save field width CMP @SS,2(R) BLE 2$ ; Enough space MOV 4(SS),-(SS) ; File pointer JSR MP,PUTLN2 TST (SS)+ ; Remove file pointer 2$: MOV (SS)+,AR ; Field length MOV @R,AD SUB AR,2(R) ; Adjust counter BGE 11$ ADD 2(R),AR ; If field > textbuff then field := textbuff CLR 2(R) 11$: SUB (HP),AR ; fieldlen - str.len BLE 7$ ; If not enough space 4$: MOVB #40,(AD)+ ; Spaces DEC AR BGT 4$ 7$: ADD (HP)+,AR ; String length BLE 10$ TST (HP)+ BEQ 5$ ; WRCHA MOV (SS)+,R 3$: MOVB (R)+,(AD)+ DEC AR BGT 3$ BR 8$ 5$: MOVB (SS)+,(AD)+ ; Insert wanted char at end TSTB (SS)+ ; Word allignment BR 8$ 10$: TST (HP)+ ; Remove WRCHA indication TST (SS)+ ; Remove string pointer 8$: MOV @SS,R MOV AD,@R ; Pointer in buffer TST 2(R) ; Remaining char counter BGT 9$ MOV @SS,-(SS) ; Double file pointer CALLSS PUTLN ; Output line if buffer full 9$: RETURN ; Leave file pointer on SS ; ;====================================================================== ; ; RDC (F,CHAR) Read char from text file ; ; 2(SS) = pointer to file window ; (SS) = address of character ; ROUTINE RDC ; MOV @2(SS),AD ; Pointer in buffer MOVB @AD,@(SS)+ ; CH := F^ MOV @SS,-(SS) ; Leave file pointer on stack BR $GET ; Consumes one file pointer ; ;====================================================================== ; ; RDREC Read one record from Pascal file ; ; 2(SS) = file, left on stack ; (SS) = record address ; ROUTINE RDREC ; MOV (SS)+,AD FINDFILE @SS MOV @R,R ; File window MOV F.RSIZ(AR),-(SS) ; Record size INC @SS ASR @SS ; Word size 1$: MOV (R)+,(AD)+ DEC @SS BGT 1$ TST (SS)+ ; Skip counter MOV @SS,R ; File BR $GET1 ; ;====================================================================== ; ; GETLN (F) Pascal readln (F) ; GET (F) Pascal get procedure ; ; (SS) = pointer to file window ; .ENABLE LSB ROUTINE GETLN MOV GP,AD ; <> zero BR GET3 ROUTINE GET CLR AD ; zero GET3: FINDFILE (SS)+,,LUNTBL(GP) ; V4-36 ; V5-35 GET2: TST EOFSTATUS(R) BNE 99$ TST AD BNE 3$ ; Br if GETLN TST EOLNSTATUS(R) BNE 3$ ; If EOLN then GETLN 2$: BIT #TEXT,FILTYP(R) BNE GETTXT ; Br if text file $GET1:: ; Alternate entry point from P11RESET 3$: BIC #GENERATE,FILTYP(R) ; Reset generation mode CLR EOLNSTATUS(R) BIT #TTY,FILTYP(R) BNE GETTTY GET$ ; Read one file record MOVB F.ERR(AR),AD ; FCS error code MOV AD,IORESULT(R) ;***** MOV(B) leaves carry bit unchanged BCC 1$ ; If transfer OK INC EOFSTATUS(R) INC EOLNSTATUS(R) ; V4-37 BR 4$ ; GP-V6:36 1$: MOV F.NRBD+2(AR),@R ; Next record buffer BNE 5$ ; V4-15 4$: ; GP-V6:36 MOV F.URBD+2(AR),@R ; User record buffer ; V4-15 5$: ; V4-15 BIT #TEXT,FILTYP(R) BEQ 9$ ; Ready if not text file MOV F.NRBD(AR),2(R) ; Remaining char counter BEQ 48$ ; Set EOLN if empty line ; GP-V6:19 9$: RETURN ; ; ; GET for text file (advance to next character or end of line) ; GETTXT: DEC 2(R) BGT 8$ ; If chars left 48$: MOV #SPACE,@R ; Required space at end of line INC EOLNSTATUS(R) ; EOLN := TRUE RETURN ; GP-V6:36 ; 8$: INC @R MOV #1,IORESULT(R) ; V4-27 RETURN ; 99$: CALLSS WRERROR ; Error, reading beyond end of file .BYTE 66.,1 RETURN ; SPACE: .ASCII ' ' ; Effective space character at end of line. .EVEN ; ; ; Get line from user terminal ; GETTTY: MOV R,AD MOV LUNTBL+<2*TILUN>(GP),AR ; V4-36 ; V5-35 CLR EOLNSTATUS(AR) ; Clear EOLN on output ; V4-36 CMP -(SS),-(SS) ; Space for IO status block SUB #FILESIZECORR+TEXTBUFFSIZE-FDBSIZE,AD QIO$S #IO.RVB,#TILUN,#5,,SS,, WTSE$S #5 MOV AD,@R MOVB @SS,AD ; 1st byte of TTY IOSB MOV AD,IORESULT(R) ; Sign extended IO result CMPB AD,#IE.EOF ; Cntl Z ; V4-47 BNE 18$ ; No ; V4-47 INC EOFSTATUS(R) ; V4-47 18$: ; V4-47 TST (SS)+ ; Skip 1st wd of IO status block MOV (SS)+,2(R) ; Number of chars BEQ 48$ ; Mark EOLN ; V4-36 19$: RETURN ; .DSABLE LSB ; ;====================================================================== ; ; TTPAR (F) If file is TTYOUT then change it to TTYIN ; ; (SS) = pointer to file window ; ; ROUTINE TTPAR MOV @SS,R ; File ID BIT #TTY,FILTYP(R) BEQ NOTTY ; If not TTY MOV LUNTBL(GP),@SS ; TTYIN ; V5-35 NOTTY: RETURN ; ;====================================================================== ; ; RDSTR Read string from text file ; ; 4(SS) = file ; 2(SS) = string address ; (SS) = string length ; ; If there are enough characters in the current line to ; fill the given string then read all the required characters ; into the string and leave the file pointer pointing at the ; next character on the line. ; ; If the line has some characters remaining but not enough ; to fill the string then read all remaining characters into ; the string and fill the rest of the string with spaces and ; leave the file pointer pointing to the position of the last ; set the file pointer pointing at a space in the internal buffer. ; ; If there are no remaining characters in the line then fill ; the string with spaces and set the file pointer pointing at ; a space character in the internal buffer. ; (It may have been a zero length line) ; ROUTINE RDSTR MOV (SS)+,AR ; Length MOV (SS)+,AD ; Address MOV @SS,R ; File SUB AR,2(R) ; Remaining chars in line BGE 2$ ADD 2(R),AR 2$: MOV @R,-(SS) ; Buffer pointer ADD AR,@R ; Update buffer pointer MOV (SS)+,R ; Old buffer pointer 4$: DEC AR BLT 6$ ; No chars in buffer MOVB (R)+,(AD)+ ; Read chars BR 4$ 6$: MOV @SS,R ; File MOV 2(R),AR ; Remaining chars BGT 14$ ; GP-V6:48 NEG AR ; Number of spaces CLR 2(R) ; Remaining chars MOV #TRUE,EOLNSTATUS(R) 8$: DEC AR ; Pad with AR spaces ; GP-V6:48 BLT 10$ ; GP-V6:48 MOVB #' ,(AD)+ ; GP-V6:48 BR 8$ ; GP-V6:48 10$: ; GP-V6:48 MOV R,AR SUB #FILESIZECORR+TEXTBUFF,AR ; GP-V6:19 BIT #TTY,FILTYP(R) ; GP-V6:19 BEQ 12$ ; GP-V6:19 ADD #FDBSIZE,AR ; GP-V6:19 12$: MOV AR,(R) ; Point to start of int. buffer ; GP-V6:19 MOVB #' ,(AR) ; F^ := ' ' ; GP-V6:19 14$: RETURN ; ; .END **** P11GRT.MAC .TITLE GRT ;****************************** GRT *********************************** ROUTINE GRT ENDGRT CLR R CMP (SS)+,(SS) BGE GRT0 INC R GRT0: MOV R,(SS) ENDGRT: RTS MP .END **** P11GRTM.MAC .TITLE GRTM ;************************ GRTM ****************************** ROUTINE GRTM ENDGRM MOV (SS)+, AR ;LOAD SOURCE ADDRESS IN AR MOV (SS)+, AD ;LOAD DESTINATION ADDRESS IN AD MOV (MP)+, R ;FETCH LENGTH ARGUMENT CALLSS GRTM2 ENDGRM: RTS MP .END **** P11GRTM2.MAC .TITLE GRTM2 ;************************* GRTM2 ************************** ROUTINE GRTM2 ENDGR2 GR20: CMPB (AD)+,(AR)+ ;COMPARE BYTES IN SOURCE AND DEST. BNE GR21 DEC R ;DECREMENT COUNTER BGT GR20 ;LOOP WHILE COUNT # 0 GR22: CLR -(SS) RTS MP GR21: BLT GR22 ;LOAD FALSE IF LESS THAN MOV #1,-(SS) ;BOOLEAN TRUE ENDGR2: RTS MP .END **** P11HEAP.MAC .TITLE P11HEAP .PSECT $99999 OVR, RO, REL, GBL, D $$HEAP:: .END **** P11IASRNC.MAC .TITLE RUNCHK (P11IASRNC) .IDENT '810225' ; CHANGE GP-V6:16 80-05-30 GP ; CHANGE GP-V6:17 80-05-30 GP ; CHANGE GP-V6:71 81-02-25 GP ; ;***************************************** ;********** ********** ;********** F O R I A S ********** ;********** ********** ;***************************************** ; ;******************************** SUBSTRCHECK *********************** ; ; INPUTS: ; 6(SS) - LOWER BOUND OF SUBSTRING (LB) ; 4(SS) - UPPER BOUND OF SUBSTRING (UB) ; 2(SS) - LOWEST ARRAY INDEX (LMIN) ; 0(SS) - HIGHEST ARRAY INDEX (LMAX) ; ; OUTPUT: ; LMIN & LMAX REMOVED FROM STACK ; ROUTINE STRCH SUBSTRCHECK MOV 6(SS),R0 ; LB DEC R0 ; LB-1 CMP 4(SS),R0 ; COMPARE LB-1 : UB BLT 20$ ; LB-1 < UB --> ERROR BEQ 10$ ; LB-1 = UB --> ZERO LENGTH SUBSTRING CMP (SS)+,2(SS) ; COMPARE LMAX : UB BLT 22$ ; UB > LMAX --> ERROR CMP (SS)+,2(SS) ; COMPARE LMIN : LB BGT 24$ ; LB < LMIN --> ERROR 9$: RTS MP ; RETURN 10$: CMP (SS)+,(SS)+ ; REMOVE LB, UB BR 9$ 20$: TST (SS)+ 22$: TST (SS)+ 24$: CALLSS WRERROR .WORD 60.+FATAL BR 9$ ;******************************* STRINGINDEX ********** ROUTINE STIND STRINGINDEX CMP 2(SS),(SS) ;COMPARE INDEX TO SIZE BLE STI1 ;ERROR TST (SS) ;TEST IF >= 0 BGE STI2 ;YES, READY STI1: CALLSS WRERROR .WORD 61.+FATAL STI2: ENDSTI: RTS MP ;*************************** OVFLCHK ***************************** ROUTINE OVFLCHK ENDOFC MOV DAPADDR(GP), AR ;AR := DAP ADD #80., AR ;KEEP FREE STORE OF 40 WORDS CMP SS, AR ;SS > AR? BHI OFC0 ;YES, CONTINUE CALLSS WRERROR .WORD 10.+FATAL OFC0: ;CHECK FOR HARDWARE STACKOVFL CMP HP, #20. ; 10 WORDS BHI ENDOFC CALLSS WRERROR .WORD 11.+FATAL ENDOFC: RTS MP ;******************************* SUBRCHK ******************************* ROUTINE SUBRCHK ENDSCK CMP (SS), (MP)+ ;LOWER BOUND BLT SCKL2 CMP (SS), (MP)+ ;UPPER BOUND BLE SCK0 SCKL1: MOV @SS,-(SS) ; OFFENDING VALUE MOV #1,-(SS) ; 1 PARAM ON STACK CALLSS WRERROR .WORD 12.+FATAL+ERPARM SCK0: RTS MP SCKL2: TST (MP)+ ;REMOVE SECOND ARGUMENT ENDSCK: BR SCKL1 .END **** P11INIT.MAC .TITLE P11INIT .IDENT '810810' ; CORRECTION V5-2 1978-07-12 STD ; CORRECTION V5-35 1979-06-26 STD ; CHANGE GP-V6:14 1980-06-03 GP ; CHANGE GP-V6:45 1980-06-10 GP ; CHANGE GP-V6:86 1981-08-08 GP ; CHANGE GP-V6:88 1981-08-10 GP .MCALL FINIT$,GTSK$S ROUTINE INITA ; PASCAL RUNTIME INITIALIZATION ; ; ; INPUT: ; (MP) ADDR OF FILE OUTPUT (GP RELATIVE) ; 2(MP) ADDR OF FILE INPUT " ; 4(MP) ADDR OF FILE TTY (OUT) " ; 6(MP) ADDR OF FILE TTYIN " ; ; REGISTER R = ADDR OF BOTTOM OF HEAP (=$$HEAP) ; ; FINIT$ ; INITIALIZE FCS MOV R,SS GTSK$S SS ; GET TASK PARAMETERS MOV 32(SS),SS ; TASK WINDOW SIZE MOV SS,(HP) ; - TO MP AT EXIT ; V5-2 SUB #2,(HP) ; POINT TO LAST WORD OF HEAP/STACK ; RESERVE SPACE FOR STANDARD FILES FILAREA=FILESIZECORR+TEXTBUFFSIZE+4 MOV MP,AD TST (AD)+ BEQ 2$ SUB #FILAREA,SS ; OUTPUT 2$: TST (AD)+ BEQ 3$ SUB #FILARE,SS ; INPUT 3$: TST (AD)+ FILAREA=FILAREA-FDBSIZE ; (TTY FILES DON'T CONTAIN FDB'S) BEQ 4$ SUB #FILAREA,SS ; TTYOUT 4$: TST (AD)+ BEQ 5$ SUB #FILAREA,SS ; TTYIN 5$: ; ALLOCATE AND INITIALIZE LUN TABLE MOV #MAXFILES+1,AD ; NUMBER OF LUN TABLE ENTRIES 7$: CLR -(SS) ; ZERO FOR ALL NON-TTY FILES SOB AD,7$ ; LOOP DEC (SS) ; TTYIN NOT AVAILABLE DEC <2*TILUN>(SS) ; TTYOUT NOT AVAILABLE ; INITIALIZE HIDDEN GLOBAL VARIABLES MOV R,-(SS) ; HEAPBOT := ADDRESS OF FIRST WORD OF HEAP MOV #$EXITP,-(SS) ; EXITP := ADDRESS OF STANDARD EXIT ROUTINE CLR -(SS) ; DAPDDT CLR -(SS) ; MARKDDT MOV R,-(SS) ; DAPADDR := BOTTOM OF HEAP MOV R,-(SS) ; MARKADDR := BOTTOM OF HEAP MOV #$P.SEL,-(SS) ; SELECTOR := DEFAULT DYNAMIC OPTIONS CLR -(SS) ; LINEADDR TST -(SS) ; RESERV SPACE FOR MOV SS,@SS ; STATIC LINK MOV SS,GP ; OPEN STANDARD FILES MOV #-2,-(HP) ; COUNTER NEW: ADD #2,@HP ; INDEX TO FNAM & OPEN-ROUTINE MOV @HP,AD MOV (MP)+,-(SS) ; FILE POINTER BEQ NOFILE ADD GP,@SS MOV #-1,-(SS) ; FILE TYPE = TEXT MOV FNAM(AD),-(SS) ; ADDR TO FNAM STRING MOV #6,-(SS) ; LEN OF FNAM STRING CLR -(SS) ; DIR STRING CLR -(SS) CLR -(SS) ; DEV STRING CLR -(SS) CLR -(SS) ; IOSPEC MOV R,-(HP) ; SAVE REGISTER JSR MP,@FSTOPN(AD) MOV (HP)+,R ; RESTORE REGISTER BR NEXT ; NOFILE: TST (SS)+ ; REMOVE ZERO NEXT: CMP @HP,#6 BNE NEW ; MORE FILEPOINTERS LEFT TST (HP)+ ; REMOVE COUNTER RETURN FSTOPN: .WORD $REWRITE,$RESET,OPNTTY,OPNTTY FNAM: .WORD NMO,NMI,NMO,NMI NMI: .ASCII /INPUT / NMO: .ASCII /OUTPUT/ .EVEN OPNTTY: ADD #16.,SS ; SKIP FILE SPEC MOV (SS)+,AR ; ADDRESS OF FILE CLR EOFSTATUS(AR) ; EOF := FALSE MOV #1,IORESULT(AR) ; IORESULT := OK MOV AR,@AR SUB #FILESICORR+TEXTBUFFSIZE-FDBSIZE,@AR ; SET FILE POINTER MOVB #' ,@(AR) ; TTYIN^ := ' ' ; V4-50 CMP AD,#6 ; WHICH FILE BNE TTYOUT MOV AR,LUNTBL(GP) ; TTYIN LUNTABLE ENTRY MOV #TRUE,EOLNSTATUS(AR) ; EOLN(TTYIN) := TRUE MOV #TTY+TEXT+INPUT,FILTYP(AR) CLR 2(AR) ; SET LINE EMPTY RETURN TTYOUT: MOV AR,LUNTBL+<2*TILUN>(GP) ; TTYOUT LUNTABLE ENTRY CLR EOLNSTATUS(AR) ; EOLN(TTYOUT) := FALSE MOV #TTY+TEXT,FILTYP(AR) MOV #TEXTBUFFSIZE,2(AR) ; A FULL LINE REMAINING RETURN ;************************************************ ; ; PROCEDURE SLCTDF( I: INTEGER ); ; V5-2 ; SLCTDF:: TST (SS)+ ; SKIP LINK MOV (SS)+,SELECTOR(GP) RTS PC .END **** P11INITS.MAC .TITLE INITS ;****************************** INITS ****************************** ROUTINE INITS ENDITS MOV (SS), AR ;TEMPORARY STORAGE OF TOPELEMENT OF STACK CLR (SS) ;CREATE AN EMPTY FOUR WORD SET CLR -(SS) CLR -(SS) CLR -(SS) MOV AR,-(SS) ;REPLACE TOPELEMENT ON THE STACK. ;TOPELEMENT = SETELEMENT TO BE ADDED TO THE SET ENDITS: RTS MP .END **** P11INIUNM.MAC .TITLE P11INITUNMAPPED (P11INIUNM) .IDENT '810810' ; CORRECTION V5-2 1978-07-12 STD ; CORRECTION V5-35 1979-06-26 STD ; CHANGE GP-V6:14 1980-06-03 GP ; CORRECTION GP-V6:45 1980-06-24 GP ; CHANGE GP-V6:86 1981-08-08 GP ; CHANGE GP-V6:88 1981-08-10 GP ; .MCALL FINIT$,GPRT$S ; ; ROUTINE INITA ; PASCAL RUNTIME INITILIZATION FOR ; UNMAPPED SYSTEMS. ; ; INPUT: ; (MP) ADDR OF FILE OUTPUT (GP RELATIVE) ; 2(MP) ADDR OF FILE INPUT " ; 4(MP) ADDR OF FILE TTY (OUT) " ; 6(MP) ADDR OF FILE TTYIN " ; ; REGISTER R = ADDR OF BOTTOM OF HEAP (=$$HEAP) ; ; FINIT$ ; INITIALIZE FCS MOV R,SS GPRT$S ,SS ; GET PARTITION PARAMETERS ADD 2(SS),(SS) ; ADD START ADDRESS AND ; V5-16 MOV (SS),SS ; PARTITION SIZE ; V5-16 ASL SS ; *2 ; V5-16 ASL SS ; *2 ; V5-16 ASL SS ; *2 ; V5-16 ASL SS ; *2 ; V5-16 ASL SS ; *2 ; V5-16 ASL SS ; *2 ; V5-16 MOV SS,(HP) ; - TO MP AT EXIT ; V5-2 SUB #2,(HP) ; POINT TO LAST WORD OF HEAP/STACK ; RESERVE SPACE FOR STANDARD FILES FILAREA=FILESIZECORR+TEXTBUFFSIZE+4 MOV MP,AD TST (AD)+ BEQ 2$ SUB #FILAREA,SS ; OUTPUT 2$: TST (AD)+ BEQ 3$ SUB #FILARE,SS ; INPUT 3$: TST (AD)+ FILAREA=FILAREA-FDBSIZE ; (TTY FILES DON'T CONTAIN FDB'S) BEQ 4$ SUB #FILAREA,SS ; TTYOUT 4$: TST (AD)+ BEQ 5$ SUB #FILAREA,SS ; TTYIN 5$: ; ALLOCATE AND INITIALIZE LUN TABLE MOV #MAXFILES+1,AD ; NUMBER OF LUN TABLE ENTRIES 7$: CLR -(SS) ; ZERO FOR ALL NON-TTY FILES SOB AD,7$ ; LOOP DEC (SS) ; TTYIN NOT AVAILABLE DEC <2*TILUN>(SS) ; TTYOUT NOT AVAILABLE ; INITIALIZE HIDDEN GLOBAL VARIABLES MOV R,-(SS) ; HEAPBOT := ADDRESS OF FIRST WORD OF HEAP MOV #$EXITP,-(SS) ; EXITP := ADDRESS OF STANDARD EXIT ROUTINE CLR -(SS) ; DAPDDT CLR -(SS) ; MARKDDT MOV R,-(SS) ; DAPADDR := BOTTOM OF HEAP MOV R,-(SS) ; MARKADDR := BOTTOM OF HEAP MOV #$P.SEL,-(SS) ; SELECTOR := DEFAULT DYNAMIC OPTIONS CLR -(SS) ; LINEADDR TST -(SS) ; RESERV SPACE FOR MOV SS,@SS ; STATIC LINK MOV SS,GP ; OPEN STANDARD FILES MOV #-2,-(HP) ; COUNTER NEW: ADD #2,@HP ; INDEX TO FNAM & OPEN-ROUTINE MOV @HP,AD MOV (MP)+,-(SS) ; FILE POINTER BEQ NOFILE ADD GP,@SS MOV #-1,-(SS) ; FILE TYPE = TEXT MOV FNAM(AD),-(SS) ; ADDR TO FNAM STRING MOV #6,-(SS) ; LEN OF FNAM STRING CLR -(SS) ; DIR STRING CLR -(SS) CLR -(SS) ; DEV STRING CLR -(SS) CLR -(SS) ; IOSPEC MOV R,-(HP) ; SAVE REGISTER JSR MP,@FSTOPN(AD) MOV (HP)+,R ; RESTORE REGISTER BR NEXT ; NOFILE: TST (SS)+ ; REMOVE ZERO NEXT: CMP @HP,#6 BNE NEW ; MORE FILEPOINTERS LEFT TST (HP)+ ; REMOVE COUNTER RETURN FSTOPN: .WORD $REWRITE,$RESET,OPNTTY,OPNTTY FNAM: .WORD NMO,NMI,NMO,NMI NMI: .ASCII /INPUT / NMO: .ASCII /OUTPUT/ .EVEN OPNTTY: ADD #16.,SS ; SKIP FILE SPEC MOV (SS)+,AR ; ADDRESS OF FILE CLR EOFSTATUS(AR) ; EOF := FALSE MOV #1,IORESULT(AR) ; IORESULT := OK MOV AR,@AR SUB #FILESICORR+TEXTBUFFSIZE-FDBSIZE,@AR ; SET FILE POINTER MOVB #' ,@(AR) ; TTYIN^ := ' ' ; V4-50 CMP AD,#6 ; WHICH FILE BNE TTYOUT MOV AR,LUNTBL(GP) ; TTYIN LUNTABLE ENTRY MOV #TRUE,EOLNSTATUS(AR) ; EOLN(TTYIN) := TRUE MOV #TTY+TEXT+INPUT,FILTYP(AR) CLR 2(AR) ; SET LINE EMPTY RETURN TTYOUT: MOV AR,LUNTBL+<2*TILUN>(GP) ; TTYOUT LUNTABLE ENTRY CLR EOLNSTATUS(AR) ; EOLN(TTYOUT) := FALSE MOV #TTY+TEXT,FILTYP(AR) MOV #TEXTBUFFSIZE,2(AR) ; A FULL LINE REMAINING RETURN ;************************************************ ; ; PROCEDURE SLCTDF( I: INTEGER ); ; V5-2 ; SLCTDF:: TST (SS)+ ; SKIP LINK MOV (SS)+,SELECTOR(GP) RTS PC .END **** P11INN.MAC .TITLE INN .IDENT '800806' ;**************************** INN ************************** ; ; SET MEMBERSHIP TEST ; ; INPUTS: ; (MP) = SIZE IN BYTES OF SET ; ; (SS) TO 6(SS) = BIG SET OR (SS) = SMALL SET ; 8.(SS) = SETELEMENT 2(SS) = SETELEMENT ; ; OUTPUT: ; ONE BOOLEAN VALUE ON STACK ; ROUTINE INN ENDINN MOV SS, AR MOV (MP)+, R ; = SIZE OF SET IN BYTES ADD R, AR ; AR = ADDRESS OF SETELEMENT MOV AR, AD ; AD = DESTINATION ADDRESS OF BOOLEAN MOV (AR), AR ; AR = SETLEMENT CLR (AD) ; INITIALIZE BOOLEAN RESULT FALSE TST AR ; TEST SETELEMENT BLT INN0 ; IF NEGATIVE RETURN FALSE ASL R ASL R ASL R ; = SET SIZE IN BITS CMP AR, R ; CHECK IF OUTSIDE SET SIZE BGE INN0 ; IF OUTSIDE RETURN FALSE MOV AR, R ; = SETELEMENT BIC #177770, AR ;AR := AR MOD 8 ASR R ; ASR R ASR R ;R := R DIV 8 ADD SS, R ;R NOW CONTAINS ADDRESS OF BYTE IN SET BITB MASKS(AR),(R) ;TEST IF SETELEMENT IS PRESENT BEQ INN0 ;ZERO RESULT --> ELEMENT NOT IN SET INC (AD) ;BOOLEAN TRUE INN0: MOV AD, SS ;REMOVE SET FROM STACK RTS MP MASKS: .WORD 001001 ;MASK TABLE .WORD 004004 ; .WORD 020020 ; ENDINN: .WORD 100100 ; .END **** P11INT4.MAC .TITLE INT4 ;****************************** INT4 ******************************* ROUTINE INT4 ENDINT MOV SS, AD ;CALCULATE SET ADDRESSES IN SS AND AD ADD #8., AD ; MOV #4, R ;INITIALIZE WORD COUNT R INT0: COM (SS) ;COMPLEMENT WORDS OF DESTINATION BIC (SS)+,(AD)+ ;BIT CLEAR DEC R ;DECREMENT WORD COUNT BGT INT0 ;LOOP WHILE COUNT # 0 ENDINT: RTS MP .END **** P11LEQ.MAC .TITLE LEQ ;****************************** LEQ ******************************** ROUTINE LEQ ENDLEQ CLR R CMP (SS)+,(SS) BLT LEQ0 INC R LEQ0: MOV R, (SS) ENDLEQ: RTS MP .END **** P11LEQM.MAC .TITLE LEQM ;*************************** LEQM *************************** ROUTINE LEQM ENDLQM MOV (SS)+, AR ;SOURCE ADDRESS IN AR MOV (SS)+, AD ;DESTINATION ADDRESS IN AD MOV (MP)+, R ;LENGTH IN BYTES IN R CALLSS LEQM2 ENDLQM: RTS MP .END **** P11LEQM2.MAC .TITLE LEQM2 ;*************************** LEQM2 *************************** ROUTINE LEQM2 ENDLQ2 LQ20: CMPB (AD)+,(AR)+ ;COMPARE BYTES IN SOURCE AND DEST BNE LQ21 ;TEST RELATION IF NOT EQUAL DEC R ;DECREMENT BYTE COUNTER BGT LQ20 ;LOOP WHILE COUNT # 0 LQ22: MOV #1,-(SS) ;LOAD BOOLEAN TRUE RTS MP LQ21: BLT LQ22 ;LESS: RESULT = TRUE CLR -(SS) ;LOAD BOOLEAN FALSE ENDLQ2: RTS MP .END **** P11LEQS1.MAC .TITLE LEQS1 ;***************************** LEQS1 ****************************** ROUTINE LEQS1 ENDLS1 CLR R ;BOOLEAN FALSE MOV (SS)+, AR ;AR CONTAINS SET BIS AR,(SS) ;FORM SET UNION CMP (SS), AR ;COMPARE SETS FOR DIFFERENCES BNE LS10 ;NOT EQUAL -->FALSE INC R ;FALSE --> TRUE LS10: MOV R,(SS) ;LOAD BOOLEAN RESULT ENDLS1: RTS MP .END **** P11LEQS4.MAC .TITLE LEQS4 ;******************************* LEQS4 **************************** ROUTINE LEQS4 ENDLS4 MOV SS, AR ;AR = ADDRESS OF SET OPERAND MOV SS, AD ADD #8., AD ;ADDRESS OF SECOND SET CLR -(SS) ;INITIALIZE BOOLEAN RESULT MOV #4, R ;LENGTH IN WORDS LS40: BIS (AR),(AD) ;SET UNION CMP (AR)+,(AD)+ ;EQUAL? BNE LS41 DEC R ;DECREMENT WORD COUNT BGT LS40 ;LOOP INC (SS) ;BOOLEAN TRUE LS41: MOV (SS), 16.(SS) ;LOAD RESULT ADD #16., SS ;REMOVE SETS ENDLS4: RTS MP .END **** P11LES.MAC .TITLE LES ;****************************** LES ********************************** ROUTINE LES ENDLES CLR R CMP (SS)+,(SS) BLE LES0 INC R LES0: MOV R, (SS) ENDLES: RTS MP .END **** P11LESM.MAC .TITLE LESM ;**************************** LESM ************************* ROUTINE LESM ENDLSM MOV (SS)+, AR ;LOAD SOURCE ADDRESS IN AR MOV (SS)+, AD ;LOAD DESTINATION ADDRESS IN AD MOV (MP)+, R ;FETCH LENGTH ARGUMENT CALLSS LESM2 ENDLSM: RTS MP .END **** P11LESM2.MAC .TITLE LESM2 ;**************************** LESM2 ************************** ROUTINE LESM2 ENDLS2 LS20: CMPB (AD)+, (AR)+ ;COMPARE SOURCE AND DESTINATION BYTES BNE LS21 DEC R BGT LS20 ;LOOP WHILE COUNT # 0 LS22: CLR -(SS) ;BOOLEAN FALSE RTS MP LS21: BGT LS22 ;FALSE RESULT IF GREATER MOV #1,-(SS) ;BOOLEAN TRUE ENDLS2: RTS MP .END **** P11MARKP.MAC .TITLE MARKP ; CORRECTION V5-44 1979-06-26 STD ;******************************* MARKP ***************************** ROUTINE MARKP ENDMRK MOV DAPADDR(GP),AD ; ; V5-44 MOV MARKADDR(GP),(AD)+ ;'HEAP' MARKPOINTER ; V5-44 MOV MARKDDT(GP), (AD)+ ; AND DDT-MARKPOINTER ; V5-44 MOV DAPADDR(GP),MARKADDR(GP) ;MARKPOINTER := DAP MOV DAPDDT(GP),MARKDDT(GP) ;MARKPOINTER := DAP MOV AD,DAPADDR(GP) ;DAP := DAP + 4 ; V5-44 ENDMRK: RTS MP ;***************************** RELEASEP **************************** ROUTINE RELEASEP ENDRLS MOV MARKADDR(GP),DAPADDR(GP) ;DAP := MARKPOINTER MOV MARKADDR(GP),AD ; V5-44 MOV (AD)+,MARKADDR(GP) ;GET MARKPOINTER FROM HEAP ; V5-44 MOV (AD)+,MARKDDT(GP) ; AND DDT-MARKP ; V5-44 ENDRLS: RTS MP .END **** P11MOVM.MAC .TITLE MOVM ;********************************* MOVM ******************************* ROUTINE MOVM ENDMVM MOV (SS)+, AR ;LOAD SOURCE ADDRESS IN AR MOV (SS)+, AD ;DESTINATION ADDRESS IN AD MOV (MP)+, R ;LENGTH ARGUMENT IN R MVM0: MOV (AR)+,(AD)+ ;MOVE WORDS FROM SOURCE TO DEST. DEC R ;DECREMENT WORD COUNT BGT MVM0 ;LOOP WHILE COUNT # 0 ENDMVM: RTS MP ;****************************** MOVM2 ***************************** ROUTINE MOVM2 ENDMM2 MOV (MP)+, R ;LENGTH ARGUMENT IN R, ;ADDRESSES ARE EXPECTED IN AR AND AD MM20: MOV (AR)+,(AD)+ ;MOVE WORDS FROM SOURCE TO DEST. DEC R ;DECREMENT WORD COUNT BGT MM20 ;LOOP ENDMM2: RTS MP ;*********************************** MOVMR ***************************** ROUTINE MOVMR ENDMMR MOV (MP)+, R ;LENGTH MMR0: MOV -(AR),-(AD) ;MOVE MULTIPLE DEC R ;DECREMENT COUNTER BGT MMR0 ENDMMR: RTS MP ;******************************** MOVTS ****************************** ROUTINE MOVTS MOV (MP)+,R MTS0: MOV -(AD),-(SS) DEC R BGT MTS0 RTS MP ;******************************** MOVFS ***************************** ROUTINE MOVFS MOV (MP)+,R MFS0: MOV (SS)+,(AD)+ DEC R BGT MFS0 RTS MP ; .END **** P11MPI.MAC .TITLE MULI ; ;***************************************** ;********** ********** ;********** NO EXTRA HARDWARE ********** ;********** ********** ;***************************************** ; ;****************************** SQI ********************************* ROUTINE SQI ENDSQI MOV (SS),-(SS) ;LOAD SECOND ARG FOR MULI CALLSS MULI ;MULTIPLY ENDSQI: RTS MP ;******************************* MULI ******************************** ROUTINE MULI ENDMULI CLR AD ;HELPVARIABLE := 0 MOV (SS)+, R ;R = FIRST OPERAND MOV (SS)+, AR ;AR = OPERAND BGE MPI0 ;IF MULTIPLIER NONNEGATIVE NEG AR ;NEGATE OPERAND NEG R ;NEGATE SECOND OPERAND (WHICH IS EXPECTED IN R) BVC MPI0 ;NO OVERFLOW? MPIL1: CALLSS WRERROR .BYTE 23.,1 ;ERROR 23,RESTARTABLE BR MPI1 MPI0: BEQ MPI1 ;EQUAL ZERO? --> READY MPI2: BIT #1, AR ;TEST FOR OPERAND EVEN BNE MPI3 ;ADDITION IF NOT ZERO MPI4: ASR AR ;DIVIDE BY 2 ASL R ;MULTIPLY BY 2 BR MPI2 ;LOOP MPI3: ADD R, AD ;COMPOSE RESULT DEC AR BNE MPI4 ;LOOP IF NOT YET READY MPI1: MOV AD,-(SS) ;RESULT ON THE STACK ENDMPI: RTS MP .END **** P11NEQ.MAC .TITLE NEQ ;******************************** NEQ ********************************** ROUTINE NEQ ENDNEQ CLR R ;BOOLEAN FALSE CMP (SS)+,(SS) ;COMPARE ITEMS ON THE STACK BEQ NEQ0 ;EQUAL --> FALSE INC R ;FALSE --> TRUE NEQ0: MOV R,(SS) ;LOAD BOOLEAN RESULT ENDNEQ: RTS MP .END **** P11NEQM.MAC .TITLE NEQM ; CORRECTION V6-1 1979-08-28 STD .IDENT /PAS601/ ;***************************** NEQM ****************************** ROUTINE NEQM ENDNQM MOV (SS)+, AR ;SOURCE ADDRESS IN AR MOV (SS)+, AD ;DESTINATION ADDRESS IN AD MOV (MP)+, R ;LENGTH ARGUMENT IN R CALLSS NEQM2 ENDNQM: RTS MP ; ; ROUTINE NEQB ENDNQB MOV (SS)+, AR ;SOURCE ADDRESS IN AR MOV (SS)+, AD ;DESTINATION ADDRESS IN AD MOV (MP)+, R ;LENGTH ARGUMENT IN R CALLSS NEQB2 ENDNQB: RTS MP .END **** P11NEQM2.MAC .TITLE NEQM2 ; CORRECTION V6-1 1979-08-28 STD .IDENT /PAS601/ ;******************************** NEQM2 ***************************** ROUTINE NEQM2 ENDQM2 QM20: CMP (AD)+,(AR)+ ;COMPARE WORDS OF SOURCE AND DESTINATION BNE QM21 DEC R ;DECREMENT WORD COUNT BGT QM20 ;LOOP WHILE COUNT # 0 CLR -(SS) ;LOAD BOOLEAN FALSE RTS MP QM21: MOV #1,-(SS) ;LOAD BOOLEAN TRUE ENDQM2: RTS MP ; ; ROUTINE NEQB2 ENDQB2 QB20: CMPB (AD)+,(AR)+ ;COMPARE BYTES OF SOURCE AND DESTINATION BNE QB21 DEC R ;DECREMENT WORD COUNT BGT QB20 ;LOOP WHILE COUNT # 0 CLR -(SS) ;LOAD BOOLEAN FALSE RTS MP QB21: MOV #1,-(SS) ;LOAD BOOLEAN TRUE ENDQB2: RTS MP .END **** P11NEQS4.MAC .TITLE NEQS4 ;******************************** NEQS4 ******************************** ROUTINE NEQS4 ENDNQ4 MOV SS, AR ;SOURCE ADDRESS IN AR MOV SS, AD ADD #8., AD ;DESTINATION ADDRESS IN AD MOV #4, R ;LENGTH IN R CALLSS NEQM2 MOV (SS), 16.(SS) ;LOAD BOOLEAN RESULT ADD #16., SS ;REMOVE SETS ENDNQ4: RTS MP .END **** P11NOFILE.MAC .TITLE P11NOFILE .IDENT '810923' ; CORRECTION V5-2 1978-07-12 STD ; CORRECTION V5-35 1979-06-26 STD ; CHANGE GP-V6:14 1980-06-10 GP ; CORRECTION GP-V6:45 1980-07-08 GP ; CHANGE GP-V6:72 1981-02-23 GP ; CHANGE GP-V6:86 1981-08-08 GP ; CHANGE GP-V6:88 1981-08-10 GP .MCALL GTSK$S, EXIT$S, EXST$S ROUTINE INITN ; PASCAL RUNTIME INITIALIZATION FOR PROGRAMS ; THAT DO NOT USE FILES OTHER THAN TTY. ; ; ; INPUT: ; (MP) ADDR OF FILE TTY (OUT) (GP RELATIVE) ; 2(MP) ADDR OF FILE TTYIN (GP RELATIVE) ; ; REGISTER R = ADDR OF BOTTOM OF HEAP (=$$HEAP) ; ; MOV R,SS GTSK$S SS ; GET TASK PARAMETERS MOV 32(SS),SS ; TASK WINDOW SIZE MOV SS,(HP) ; - TO MP AT EXIT ; V5-2 SUB #2,(HP) ; POINT TO LAST WORD OF HEAP/STACK ; RESERVE SPACE FOR STANDARD FILES TTYIN & TTYOUT IF DECLARED FILAREA=FILESIZECORR+TEXTBUFFSIZE+4-FDBSIZE TST (MP) ; TTYOUT BEQ 4$ ; BR IF TTY NOT DECLARED SUB #2*FILAREA,SS ; SPACE FOR TTYOUT AND TTYIN 4$: ; ALLOCATE AND INITIALIZE LUN TABLE MOV #MAXFILES+1,AD ; NUMBER OF LUN TABLE ENTRIES 6$: CLR -(SS) ; ZERO FOR ALL NON-TTY FILES SOB AD,6$ ; LOOP DEC (SS) ; TTYIN NOT AVAILABLE ; V5-35 DEC <2*TILUN>(SS) ; TTYOUT NOT AVAILABLE ; V5-35 ; INITIALIZE HIDDEN GLOBAL VARIABLES MOV R,-(SS) ; HEAPBOT := ADDRESS OF FIRST WORD OF HEAP MOV #$EXITN,-(SS) ; EXITP := ADDRESS OF NON-FILE EXIT ROUTINE CLR -(SS) ; DAPDDT CLR -(SS) ; MARKDDT MOV R,-(SS) ; DAPADDR := BOTTOM OF HEAP MOV R,-(SS) ; MARKADDR := BOTTOM OF HEAP MOV #$P.SEL,-(SS) ; SELECTOR := DEFAULT DYNAMIC OPTIONS CLR -(SS) ; LINEADDR TST -(SS) ; RESERV SPACE FOR MOV SS,@SS ; STATIC LINK MOV SS,GP ; OPEN STANDARD FILES TST (MP) BNE 10$ ; BR IF TTY DECLARED ADD #4,MP ; SKIP PARAMETERS BR 12$ 10$: MOV (MP)+,AR ; TTYOUT ADD GP,AR CALLSS OPTOUT MOV (MP)+,AR ; TTYIN ADD GP,AR CALLSS OPTIN 12$: RETURN $OPTOU: MOV AR,LUNTBL+<2*TILUN>(GP) ; TTYOUT LUNTABLE ENTRY ; V5-35 CLR EOLNSTATUS(AR) ; EOLN(TTYOUT) := FALSE MOV #TTY+TEXT,FILTYP(AR) MOV #TEXTBUFFSIZE,2(AR) ; A FULL LINE REMAINING BR TTYOPN $OPTIN: MOV AR,LUNTBL(GP) ; TTYIN LUNTABLE ENTRY ; V5-35 MOV #TRUE,EOLNSTATUS(AR) ; EOLN(TTYIN) := TRUE MOV #TTY+TEXT+INPUT,FILTYP(AR) CLR 2(AR) ; SET LINE EMPTY TTYOPN: CLR EOFSTATUS(AR) ; EOF := FALSE MOV #1,IORESULT(AR) ; IORESULT := OK MOV AR,(AR) ; FILE POINTER SUB #,(AR) MOVB #' ,@(AR) ; TTY^ := ' ' RETURN ;*********************************************************** ROUTINE EXITN ; (SS) - EXIT STATUS VALUE EXST$S (SS)+ ; EXIT WITH STATUS IF AVAILABLE EXIT$S ; ELSE PLAIN EXIT .END **** P11NOFUNM.MAC .TITLE P11NOFUNM .IDENT '810923' ; CORRECTION V5-2 1978-07-12 STD ; CORRECTION V5-35 1979-06-26 STD ; CHANGE GP-V6:14 1980-06-10 GP ; CORRECTION GP-V6:45 1980-06-24 GP ; CHANGE GP-V6:72 1981-02-23 GP ; CHANGE GP-V6:86 1981-08-08 GP ; CHANGE GP-V6:88 1981-08-10 GP .MCALL GPRT$S, EXIT$S, EXST$S ROUTINE INITN ; PASCAL RUNTIME INITIALIZATION FOR PROGRAMS ; THAT DO NOT USE FILES OTHER THAN TTY. ; FOR PROGRAMS RUNNING ON UNMAPPED SYSTEMS. ; ; ; INPUT: ; (MP) ADDR OF FILE TTY (OUT) (GP RELATIVE) ; 2(MP) ADDR OF FILE TTYIN (GP RELATIVE) ; ; REGISTER R = ADDR OF BOTTOM OF HEAP (=$$HEAP) ; ; MOV R,SS GPRT$S ,SS ; GET PARTITION PARAMETERS ADD 2(SS),(SS) ; ADD PARTITION SIZE TO MOV (SS),SS ; START ADDRESS ASL SS ; *2 ASL SS ; *2 ASL SS ; *2 ASL SS ; *2 ASL SS ; *2 ASL SS ; *2 MOV SS,(HP) ; - TO MP AT EXIT ; V5-2 SUB #2,(HP) ; POINT TO LAST WORD OF STACK/HEAP ; RESERVE SPACE FOR STANDARD FILES TTYIN & TTYOUT IF DECLARED FILAREA=FILESIZECORR+TEXTBUFFSIZE+4-FDBSIZE TST (MP) ; TTYOUT BEQ 4$ ; BR IF TTY NOT DECLARED SUB #2*FILAREA,SS ; SPACE FOR TTYOUT AND TTYIN 4$: ; ALLOCATE AND INITIALIZE LUN TABLE MOV #MAXFILES+1,AD ; NUMBER OF LUN TABLE ENTRIES 6$: CLR -(SS) ; ZERO FOR ALL NON-TTY FILES SOB AD,6$ ; LOOP DEC (SS) ; TTYIN NOT AVAILABLE ; V5-35 DEC <2*TILUN>(SS) ; TTYOUT NOT AVAILABLE ; V5-35 ; INITIALIZE HIDDEN GLOBAL VARIABLES MOV R,-(SS) ; HEAPBOT := ADDRESS OF FIRST WORD OF HEAP MOV #$EXITN,-(SS) ; EXITP := ADDRESS OF NON-FILE EXIT ROUTINE CLR -(SS) ; DAPDDT CLR -(SS) ; MARKDDT MOV R,-(SS) ; DAPADDR := BOTTOM OF HEAP MOV R,-(SS) ; MARKADDR := BOTTOM OF HEAP MOV #$P.SEL,-(SS) ; SELECTOR := DEFAULT DYNAMIC OPTIONS CLR -(SS) ; LINEADDR TST -(SS) ; RESERV SPACE FOR MOV SS,@SS ; STATIC LINK MOV SS,GP ; OPEN STANDARD FILES TST (MP) BNE 10$ ; BR IF TTY DECLARED ADD #4,MP ; SKIP PARAMETERS BR 12$ 10$: MOV (MP)+,AR ; TTYOUT ADD GP,AR CALLSS OPTOUT MOV (MP)+,AR ; TTYIN ADD GP,AR CALLSS OPTIN 12$: RETURN $OPTOU: MOV AR,LUNTBL+<2*TILUN>(GP) ; TTYOUT LUNTABLE ENTRY ; V5-35 CLR EOLNSTATUS(AR) ; EOLN(TTYOUT) := FALSE MOV #TTY+TEXT,FILTYP(AR) MOV #TEXTBUFFSIZE,2(AR) ; A FULL LINE REMAINING BR TTYOPN $OPTIN: MOV AR,LUNTBL(GP) ; TTYIN LUNTABLE ENTRY ; V5-35 MOV #TRUE,EOLNSTATUS(AR) ; EOLN(TTYIN) := TRUE MOV #TTY+TEXT+INPUT,FILTYP(AR) CLR 2(AR) ; SET LINE EMPTY TTYOPN: CLR EOFSTATUS(AR) ; EOF := FALSE MOV #1,IORESULT(AR) ; IORESULT := OK MOV AR,(AR) ; FILE POINTER SUB #,(AR) MOVB #' ,@(AR) ; TTY^ := ' ' RETURN ;*********************************************************** ROUTINE EXITN ; (SS) - EXIT STATUS VALUE EXST$S (SS)+ ; EXIT WITH STATUS IF AVAILABLE EXIT$S ; ELSE PLAIN EXIT .END **** P11PAGE.MAC .TITLE P11PAGE .IDENT '810225' ; ; PAGE (F) START NEW PAGE ON TEXT FILE F ; ; (SS) = FILE ; ROUTINE PAGE MOV (SS),R CMP 2(R),#TEXTBUFFSIZE ; IF LINE IS NOT EMPTY BEQ 10$ ; THEN MOV @SS,-(SS) ; WRITE OUT CURRENT LINE. CALLSS PUTLN 10$: MOV #FF,-(SS) ; PUT OUT A LINE WITH A SINGLE CALLSS WRC ; FORM FEED CALLSS PUTLN RETURN .END **** P11PBOOL.MAC .TITLE PBOOL ;********************************** IXB ******************************* ROUTINE IXB ENDIXB MOV (SS)+, AR ;AR = (CORRECTED) INDEXVALUE FOR PACKED ;BOOLEAN ARRAY MOV AR, R ;COPY ASR R ASR R ASR R ;R = INDEXVALUE DIV 8 BIC #177770, AR ;AR = INDEXVALUE MOD 8 MOV (SS)+, AD ;AD = ACTUAL ADDRESS OF PACKED B ARRAY ADD R, AD ;AD = BYTE ADDRESS IN PACKED BOOLEAN ARRAY ADD PC, AR ;SELECT MASK BYTE MOVB 6(AR), AR ;MASK BYTE IN AR RTS MP .WORD 001001 ;BYTE MASK TABLE .WORD 004004 .WORD 020020 ENDIXB: .WORD 100100 ;********************************* STPB ****************************** ROUTINE STPB ENDSTB MOV (SS)+,-(HP) ;STORE BOOLEAN CALLSS IXB TST (HP)+ ;TEST BOOLEAN VALUE BEQ STB0 ;ZERO --> CLEAR BYTE BISB AR,(AD) ;TRUE --> SET BYTE RTS MP STB0: BICB AR,(AD) ;SET BOOLEAN FALSE ENDSTB: RTS MP ;******************************** LPB ****************************** ROUTINE LPB ENDLPB CALLSS IXB CLR R ;BOOLEAN FALSE IN R BITB AR,(AD) ;TEST BOOLEAN VALUE BEQ LPB0 ;EQUAL --> FALSE INC R ;BOOLEAN FALSE --> TRUE LPB0: MOV R,-(SS) ;LOAD BOOLEAN VALUE ENDLPB: RTS MP ;******************************** CLRAREA **************************** ROUTINE CLRAREA ENDCLA MOV DAPADDR(GP), AD ;AD = DYNAMIC AREA POINTER (FORMER NP) MOV (MP)+, R ;R = LENGTH OF AREA TO BE CLEARED BEQ ENDCLA CLA0: CLR (AD)+ ;CLEAR WORD DEC R ;DECREMENT WORD COUNT BGT CLA0 ;LOOP ENDCLA: RTS MP ;****************************** CLRSTK ******************************** ROUTINE CLRSTK ENDCLS MOV (MP)+, R ;R = LENGTH ARGUMENT BEQ ENDCLS ;BR IF NOTHING TO CLEAR CLS0: CLR -(SS) ;CLEAR STACKSPACE DEC R ;DECREMENT WORD COUNT BGT CLS0 ;LOOP ENDCLS: RTS MP .END **** P11RANDOM.MAC .TITLE P11RANDOM .IDENT '800601' ; CORRECTION GP-V6:32 1980-06-01 GP ; .MCALL QIO$S,WTSE$S,FDOF$L ; FDOF$L ; DEFINE FDB OFFSETS ; .SBTTL GETR, PUTR ; ; PUTR(F,RNR) ; ; GETR(F,RNR) ; ; 2(SS) = POINTER TO FILE POINTER ; (SS) = RECORD NUMBER ; ROUTINE PUTRM CLR AD ; ZERO BR PUTR1 ; ROUTINE GETRM MOV GP,AD ; <> ZERO ; PUTR1: FINDFILE 2(SS),#4 ;;; V4-45 BIT #BLKMODE,FILTYP(R) BNE 10$ ; IF BLOCK MODE MOV (SS)+,F.RCNM+2(AR) CLR F.RCNM(AR) ; HIGH PART OF RNR = 0 TST (SS)+ ; SKIP FILE POINTER TST AD ; GETR OR PUTR BEQ 1$ ; IF PUTR JMP $GET1 ; IF GETR 1$: JMP $PUT2 ; ; ; 10$: MOV #IO.RVB,-(SS) TST AD BNE 20$ MOV #IO.WVB,@SS 20$: MOVB F.LUN(AR),AD CMP -(SS),-(SS) ; RESERV AREA FOR IOSB QIO$S 4(SS),AD,#5,,SS,,<@R,F.URBD(AR),,#0,6(SS)> ; GP-V6:32 WTSE$S #5 ; GP-V6:32 MOVB @SS,AD MOV AD,IORESULT(R) ADD #10.,SS ; REMOVE ALL PARAMETERS RETURN ; ; .END **** P11RDHLP.MAC .TITLE RDHLP .IDENT '800530' ; CORRECTION V4-12 1977-06-15 OEN ; CORRECTION V4-28 1977-08-12 STD ; CORRECTION V4-48 1977-10-12 STD ; CORRECTION V4-52 1977-10-12 STD ; CORRECTION V5-6 1978-11-21 STD ; CORRECTION GP-V6:18 1980-05-30 GP ; ;************************** SKIPSPACES ************************* ;READS CHAR'S UNTIL NEXTCH <> SPACE OR TAB ;(SS) = FILE ID ( LEFT ON STACK ) ROUTINE SKPSP ; SKIP SPACES MOV @SS,R MOVB @(R), R0 ;LOAD CHARACTER CMP R0,#40 ;BLANK? BEQ SKP3 ; YES ; GP-V6:18 CMP R0,#11 ;TAB? ; GP-V6:18 BNE SKP1 ; NO ; GP-V6:18 SKP3: TST EOFSTATUS(R) ; GP-V6:18 BNE SKP1 TST EOLNSTATUS(R) ; V4-48 BEQ SKP2 ; V4-48 BIT #TTY,FILTYP(R) ; V4-48 BNE SKP1 ; STOP AT EOLN IF TTY ; V4-48 SKP2: MOV (SS),-(SS) ;DOUBLE FILE ID CALLSS GET ;GET NEXT CHARACTER BR $SKPSP SKP1: RETURN ;************************** RDSIGN ************************* ;READS A SIGN AND LEAVES IT IN R1 ;(SS) = FILE ID ( LEFT ON STACK ) ROUTINE RDSIGN 1$: CALLSS SKPSP CMP R0,#40 ; SPACE ; V4-48 BNE 2$ ; V4-48 MOV @SS,-(SS) ; V4-48 CALLSS GET ; V4-48 BR 1$ ; POSSIBLE FOR TTY ; V4-48 2$: CLR -(HP) ;SIGN FLAG ; V4-48 CMP R0,#'+ ;PLUS? BEQ RDS1 ;YES CMP R0,#'- ;MINUS? BNE RDS2 ;NO -->NO SIGN AT ALL DEC (HP) ;SIGN FLAG -1 RDS1: ; V4-12 MOV (SS),-(SS) ;DOUBLE FILE ID CALLSS GET MOVB @(R1),R0 ;LEAVE NEXT CHARACTER IN R0 RDS2: MOV (HP)+,R1 ;SIGN FLAG RTS MP ;*************************** DIGIT *************************** ;CHECKS DIGITS AND LEAVES THEM AS INTEGERS IN R0 ROUTINE DIGIT ENDDGT RANGE: CMP R0, #': BMI RNG2 ;MAYBE IN RANGE RNG1: SEV ;SET V-BIT RTS MP ;CHARACTER NOT DIGIT RNG2: CMP R0, #'0 BMI RNG1 ;NOT IN RANGE SUB #'0,R0 ;IN RANGE, CLEAR V-BIT ENDDGT: RTS MP ;**************************** UNSINT ************************** ;READS AN UNSIGNED INTEGER ; 4(SS) FILE ID ; 2(SS),(SS) ROOM FOR LONG INTEGER ( INITIALIZED ) ; 2(HP) COUNTER FOR SKIPPED DIGITS DECCNT = %1 ROUTINE UNSINT ENDUSI CLR DECCNT ;COUNTS DECIMALS CALLSS DIGIT BVC USI2 ;V-BIT CLEAR --> DIGIT READ CLV ;CLEAR V BIT: NO DIGIT READ RTS MP ;VALUE 0, V-BIT CLEAR USIL2: CALLSS DIGIT ;TEST NEXT CHARACTER BVS USI4 ;NO DIGIT --> LEAVE USI2: CMP (R5),#3276. ; 32767 / 10 ; V5-6 BGE MLT0 ; OVERFLOW ASL 2(R5) ;MULTIPLY LONG BY TEN ROL (R5) MOV (R5),-(HP) MOV 2(R5),-(HP) ASL 2(R5) ROL (R5) ASL 2(R5) ROL (R5) ADD (HP)+, 2(R5) ADC (R5) ADD (HP)+,(R5) ADD R0, 2(R5) ;LAST DIGIT READ ADC (R5) INC DECCNT ;INCREMENT EXPONENT MLT2: MOV DECCNT,-(HP) MOV 4(SS),-(SS) ;FILE ID CALLSS GET ; NEXT CHARACTER MOVB @(R), R0 ;IN R0 MOV (HP)+,DECCNT BR USIL2 MLT0: INC 2(HP) ;V5-6 BR MLT2 ;V5-6 USI4: ENDUSI: RTS MP ;THE LONG INTEGER IS NOW IN (R5), 2(R5), ;V-BIT SET MEANS: DIGITS READ .END **** P11RDI.MAC .TITLE RDI .IDENT '800601' ; CORRECTION V4-29 1977-08-12 ; CORRECTION V4-52 1977-10-12 STD ; CORRECTION V5-6 1978-11-21 STD ; CORRCETION V5-15 1978-11-21 STD ; CORRECTION GP-V6:29 1980-06-01 GP ;*************************** RDI ******************************* ;READS AN INTEGER AND STORES IT AT THE ADDRESS IN (SS) ;2(SS) FILE ( LEFT ON STACK ) ROUTINE RDI ENDRDI MOV (SS)+,-(HP) ;SAVE RESULT ADDRESS CALLSS RDSIGN MOV R1,-(HP) ;STORE SIGN CLR -(HP) ;INITIATE SKIP COUNT ; V5-6 CLR -(SS) CLR -(SS) ;INITIATE LONG INTEGER ON STACK CALLSS UNSINT ;READ UNSIGNED INTEGER BVS RDI0 ;DIGITS READ IF V-BIT SET ;NO DIGITS AFTER SIGN ; V4-29 MOV 4(SS),R ; FILE ID ; V4-29 MOV #-104.,IORESULT(R) ; ERROR NUMBER ; V4-29 CALLSS WRERROR ; V5-0 .WORD 40.+MESSAGE ; V5-0 RDI0: TST (SS)+ ;TEST HIGH WORD OF LONG INT BEQ RDI1 RDIL4: MOV #077777,@SS ;NUMBER TOO LARGE ; V4-29 MOV 2(SS),R ; FILE ID ; V4-29 MOV #-105.,IORESULT(R) ; ERROR NUMBER ; V4-29 CALLSS WRERROR ; V5-0 .WORD 41.+MESSAGE ; V5-0 RDI1: TST (HP)+ ; REMOVE SKIP COUNT ; V5-6 TST (HP) ; TEST SIGN FLAG ; GP-V6:29 BEQ 10$ ; BR IF '+' ; GP-V6:29 NEG (SS) ; SIGN IS '-', NEGATE NUMBER ; GP-V6:29 BPL RDIL4 ; ERROR IF IT DIDN'T GO NEGATIVE; GP-V6:29 BR 20$ ; GP-V6:29 10$: TST (SS) ; SIGN IS '+', TEST NUMBER ; GP-V6:29 BMI RDIL4 ; ERROR IF NEGATIVE ; GP-V6:29 20$: TST (HP)+ ; DISCARD SIGN FLAG ; GP-V6:29 RDI3: MOV (SS)+,@(HP)+ ;STORE INTEGER MOV @SS,R ; V5-0 TST IORESULT(R) ; V5-0 BLT ENDRDI ; V5-0 BIT #SKIPSP,SELECTOR(GP) ; V5-0 BEQ ENDRDI ; V5-0 CALLSS SKPSP ; SKIP SPACES ; V4-52 ENDRDI: RTS MP .END **** P11RDR.MAC .TITLE RDR ; CORRECTION V4-30 1977-08-12 STD ; CORRECTION V5-6 1978-11-21 STD ;**************************** RDR **************************** DECCNT=%1 ; ;READS A REAL NUMBER AND STORES IT AT THE ADDRESS IN (SS) ; 2(SS) = FILE ID ( LEFT ON STACK ) ROUTINE RDR ENDRDR MOV (SS)+,-(HP) ;ADDRESS OF RESULT CALLSS RDSIGN ;READ SIGN MOV R1,-(HP) ;STORE SIGN FLAG CLR -(HP) ;INITIATE DECEXP ON STACK CLR -(HP) ;INITIATE SKIP COUNT ;V5-6 CLR -(SS) CLR -(SS) ;CREATE ROOM FOR LONG INTEGER CALLSS UNSINT ;TRY TO READ AN UNSIGNED INT BVS RDR1 ;INTO (R5), 2(R5). IF V-BIT CLEAR ;THEN NO DIGITS READ CMP R0, #'E ;LAST READ CHARACTER AN 'E'? BEQ RDR12 ;YES CMP R0, #'. ;LAST CHARACTER A '.' THEN? BEQ RDRL3 ;YES MOV 4(SS),R ; FILE ID ; V4-30 MOV #-106.,IORESULT(R) ; NOT DIGIT "." OR "E" ; V4-30 CALLSS WRERROR ; V5-0 .BYTE 44.,4 ; V5-0 TST (HP)+ ;REMOVE SKIP COUNT ;V5-6 CMP (HP)+,(HP)+ ; REMOVE SIGN & DECEXP ; V4-30 BR RDR5 ; REAL = 0.0 ; V4-30 RDR12: INC 2(R5) ;LONG INT MUST BE 1 BR RDR3 RDR1: ADD (HP),2(HP) ;SKIPPED DIGITS SIGNIF ; V5-6 CMP R0, #'. ;LAST CHAR A DECIMAL POINT? BNE RDR2 ;NO RDRL3: MOV 4(SS),-(SS) ;FILE ID CALLSS GET ;YES, GET NEXT CHARACTER MOVB @(R), R0 ;AND STORE IT IN R0 CALLSS UNSINT ;ADD FRACTION PART TO LONG INT SUB DECCNT,2(HP) ;UPDATE DECIMAL EXPONENT; V5-6 RDR2: CMP R0, #'E ;EXPONENT PART? BNE RDR4 ;NO RDR3: CLR -(SS) ;YES, PREPARE FOR RDI MOV SS, R2 ;ADDRESS FOR INTEGER VALUE MOV 6(SS),-(SS) ;FILE ID TO RDI MOV R2,-(SS) ;LOAD ADDRESS FOR RDI MOV 2(SS),-(SS) ;FILE ID TO GET CALLSS GET ;GET NEXT CHARACTER CALLSS RDI ;READ EXPONENT AND LEAVE IN IN (SS) TST (SS)+ ;REMOVE FILE ID ADD (SS)+,2(HP) ;UPDATE DECIMAL EXPONENT; V5-6 LDCLF: ;CONVERT A LONG INTEGER TO FLOATING REAL RDR4: TST (HP)+ ; REMOVE SKIP COUNT ; V5-6 TST (R5) ;TEST HIGH WORD BNE CLF1 ;NUMBER IS >= 0 TST 2(R5) ;LEAST SIGN PART BEQ CLF2 ;NO NEED TO NORM IF EQUAL CLF1: MOV #30, R2 ;STANDARD NO OF SHIFTS CLR R1 ;NO CARRY CLR R0 ;SIGN FLAG CALLSS NORM ;NORMALIZE FRACTION CLF2: MOV #-1,R0 ;INITIALIZE SIGN FLAG MOV (HP)+, R2 ;RESTOREE DECIMAL EXPONENT BPL CLF3 INC R0 ;SIGN FLAG NEG R2 ;DECEXP > 0 CLF3: CALLSS SCALE MOV (HP)+, R0 ;TEST SIGN OF REAL BPL RDR5 ;PLUS? BIS #100000,(R5) ;SET SIGN BIT RDR5: MOV (HP)+, R0 ;GET REAL ADDRESS MOV (SS)+,(R0)+ MOV (SS)+,(R0)+ ;STORE REAL MOV @SS,R ; V5-0 TST IORESULT(R) ; V5-0 BLT ENDRDR ; V5-0 BIT #SKIPSP,SELECTOR(GP) ; V5-0 BEQ ENDRDR ; V5-0 CALLSS SKPSP ; SKIP SPACES ; V4-52 ENDRDR: RTS MP .END **** P11REAL.MAC .TITLE P11RAR (P11REAL) REAL ARITHMETIC SUBROUTINES .IDENT '840129' ; CHANGE GP-V6:30 1980-06-01 GP ; CORRECTION GP-V6:31 1980-06-01 GP ; CORRECTION GP-V6:67 1980-09-17 GP ; CORRECTION GP-V6:68 1980-09-17 GP ; CORRECTION GP-V6:93 1984-01-29 GP ; ;***************************************** ;********** ********** ;********** NO EXTRA HARDWARE ********** ;********** ********** ;***************************************** ; ;************************** SCALE **************************** ;R0 CONTAINS SIGN FLAG: R0 = 0 --> PLUS OR ZERO, R0 = -1 --> MINUS ;RAW DECIMAL EXPONENT IN R2 ;AFTER EXECUTION: R0 UNCHANGED, R2 = 0 ROUTINE SCALE ENDSCL SCL0: TST R2 ;ZERO? BEQ SCL6 ;YES, READY CMP R2, #11. ;DECEXP >=10? BPL SCL2 DEC R2 ASL R2 ASL R2 MOV R2, R1 ;FIND POWER TABLE ENTRY CLR R2 ;AND SAVE R2 ADD PC, R1 ;BASE ADDRESS BZX1: ADD #TENPOW+4-BZX1, R1 ;TENPOWERS BR SCL3 SCL2: SUB #10., R2 ;DECREMENT DECEXP BY TEN MOV PC, R1 ;BASE ADDRESS BZX2: ADD #TENPWO+4-BZX2, R1 ;FLOATING E10 SCL3: MOV -(R1),-(SS) MOV -(R1),-(SS) ;LOAD TENPOWERS MOV R2,-(HP) ;STORE DECEXP MOV R0,-(HP) ;STORE R0 BPL SCL4 ;BRANCH IF PLUS --> DIVIDE CALLSS MULR ;MULTIPLY BR SCL5 SCL4: CALLSS DIVR SCL5: MOV (HP)+, R0 MOV (HP)+, R2 ;RESTORE REGISTERS BR SCL0 ;TRY AGAIN SCL6: RTS MP TENPOW: .FLT2 1E1 .FLT2 1E2 .FLT2 1E3 .FLT2 1E4 .FLT2 1E5 .FLT2 1E6 .FLT2 1E7 .FLT2 1E8 .FLT2 1E9 TENPWO: .FLT2 1E10 ;TABLE OF TENPOWERS ENDSCL=.-2 ;********************************** RND *************************** ;ADDS 0.5 TO THE REAL IN (SS), 2(SS) BEFORE TRUNCATION ROUTINE RND ENDRND CLR -(SS) MOV #40000, -(SS) ;LOAD REAL VALUE 0.5 BIT #100000,4(SS) ; V4-13 BEQ RND1 ; V4-13 BIS #100000,(SS) ; SET CORRECT SIGN ; V4-13 RND1: CALLSS ADDR ;ADD ; V4-13 CALLSS TRC ;TRUNCATE ENDRND: RTS MP ;******************************* TRC **************************** ;EXPECTS A REAL AT (SS), 2(SS). LEAVES AN INTEGER AT (SS) ;REGISTER USE: R0, R1, AND R2 ROUTINE TRC ENDTRC CALLSS EXPTOP ;RETURNS R1=EXP, R0=SIGN CLR R2 ;CLEAR RESULT TST R1 BLE TRC2 ;EXP <=0 --> RESULT = 0 CMP R1, #16. ;EXP TOO LARGE? BLT TRC3 ;NO CALLSS WRERROR .BYTE 33.,1 BR TRC2 TRC3: ASL 2(R5) ;SHIFT ROL (R5) ROL R2 ;COMPOSE INTEGER DEC R1 BGT TRC3 ;LOOP MOVB R2, (R5) ;MOVE SECOND BYTE SWAB (R5) ;SWAP BYTES MOV (R5), R2 ;RESULT IN R2 TST R0 BEQ TRC2 ;INTEGER > 0? NEG R2 TRC2: CMP (R5)+,(R5)+ MOV R2,-(SS) ENDTRC: RTS MP ;************************** SQRR ****************************** ROUTINE SQRR ENDSQR MOV 2(SS),-(SS) ;COPY THE REAL ON TOP OF THE STACK MOV 2(SS),-(SS) ; CALLSS MULR ENDSQR: RTS MP ;******************************* ADDR ******************************* ; ; REAL ADDITION: R := A + B ; ; INPUT: ; 6(R5), 4(R5) = A ; 2(R5), (R5) = B ; ; OUTPUT: ; R5 INCREMENTED BY 4 ; 2(R5), (R5) = R ROUTINE ADDR ENDADDR TST @R5 ; B = ZERO ? BNE 1$ ; NO ADD #4,R5 ; YES, JUST SKIP IT BR ENDADR 1$: TST 4(R5) ; A = ZERO? BNE 2$ ; NO MOV (R5)+,2(R5) ; RESULT := B MOV (R5)+,2(R5) BR ENDADR 2$: CALLSS EXPTOP ; R1 := E(B) (EXPONENT OF B) ; R0(8) := SIGN OF B TST R0 ; NEGATE MANTISSA IF NUMBER IS NEGATIVE BEQ 3$ ; SKIP IF NOT NEG 2(R5) ADC (R5) NEG (R5) CLR R0 3$: CALLSS EXPNTOP ; R2 := E(A) ; R0(0) := SIGN OF A TST R0 ; NEGATE MANTISSA IF NUMBER IS NEGATIVE BEQ 4$ ; SKIP IF NOT NEG 6(R5) ADC 4(R5) NEG 4(R5) 4$: ; REARRANGE NUMBERS IF NECESSARY SO THAT NUMBER WITH SMALLER EXPONENT ; IS IN (R5), 2(R5). CMP R2,R1 ;COMPARE EXPONENTS BGE ADR2 ;SKIP IF SMALLER ALREADY AT TOP MOV (R5)+,-(HP) ;WE HAVE TO INTERCHANGE A AND B MOV (R5)+,-(HP) MOV 2(R5),-(R5) MOV 2(R5),-(R5) MOV (HP)+,6(R5) MOV (HP)+, 4(R5) ;INTERCHANGE FRACTIONS MOV R2,-(HP) MOV R1,R2 MOV (HP)+,R1 ;INTERCHANGE EXPONENTS ADR2: CLR -(HP) ;CLEAR FOR CARRY BITS SUB R2, R1 BEQ ADR4 ;NO SHIFTING NEG R1 ;SHIFT COUNTER CMP R1, #26. ;BIG DIFFERENCE IN EXPONENTS? BPL ADR5 ;YES ADR3: ASR (R5) ROR 2(R5) ;DIVIDE BY 2^(E(A)-E(B)) ROR (HP) ;STORE CARRY BIT DEC R1 BNE ADR3 ;LOOP ADR4: ADD 2(R5),6(R5) ;ADD FRACTIONS ADC 4(R5) ADD (R5),4(R5) ADR5: CMP (R5)+,(R5)+ CLR R0 ;ASSUME POSITIVE RESULT BIC #37777,(HP) ;PRESERVE TWO EXTRA BITS DURING NEGATE LIKE HW TST (R5) ;BOTH SIGNS 'PLUS'? BGE ADR6 NEG (HP) ;COMPLEMENT OVERFLOW ADC 2(R5) NEG 2(R5) ;NEGATE THE SMALLER FRACTION ADC (R5) NEG (R5) INC R0 ;SET SIGN NEGATIVE ADR6: MOV (HP)+, R1 ;PUT CARRY BITS IN R1 BIC #77777,R1 ;PRESERVE ONLY ONE EXTRA BIT DURING NORM AS HW CALLSS NORM ;NORMALIZE AND PACK IN (R5), 2(R5) ENDADR: RTS MP ;******************************* MULR ***************************** ROUTINE MULR ENDMPR TST 4(R5) ;ZERO? BEQ MPR1 TST (R5) ;SECOND OPERAND ZERO? BNE MPR2 MPR1: CMP (R5)+,(R5)+ ;REMOVE SECOND OPERAND CLR (R5) CLR 2(R5) ;ZERO RESULT RTS MP MPR2: CALLSS EXPTOP CALLSS EXPNTOP ;GET EXPONENTS IN R2,R3 ;AND SIGNS IN R0 ADD R1, R2 ;COMPUTE RAW EXPONENT ADD #10, R2 MOV R0,-(HP) ;SAVE SIGNS MOV #24.,-(HP) ;SHIFT COUNT CLR R0 CLR R1 MPR3: ASL R0 ;R0 = LEAST SIGNIFICANT PART ROL R1 ;THEN COMES R1, 6(R5) AND 4(R5) ROL 6(R5) ROL 4(R5) ;DOUBLE PRECISION SHIFT BIT #400,4(R5) ;MOST SIGNIFICANT BIT BEQ MPR4 ADD 2(R5), R0 ADC R1 ADC 6(R5) ADC 4(R5) ADD (R5), R1 ADC 6(R5) ADC 4(R5) MPR4: DEC (HP) BGT MPR3 ;GO AGAIN TST (HP)+ ;REMOVE COUNT CLRB 5(R5) ; MOV (HP)+, R0 ;RESTORE SIGNS CMP (R5)+,(R5)+ ;REMOVE SECOND OPERAND CALLSS SIGNS ;GET RESULT SIGN IN R0 ENDMPR: RTS MP ;***************************** SIGNS ****************************** ;REGISTER USE: R0 ONLY ;R2, R0 ARE PASSED TO NORM ROUTINE SIGNS ENDSGN TST R0 BEQ SGN0 ;BOTH 'PLUS' ASL R0 CMP R0, #1002 BEQ SGN0 ;BOTH 'MINUS' MOV #1, R0 SGN0: CALLSS NORM ;NORMALIZE REAL ENDSGN: RTS MP ;******************************** SUBR **************************** ROUTINE SUBR ENDSUBR TST (SS) ; CHECK IF SUBTRACTING ZERO ; GP-V6:31 BNE SUBRL2 ; BR IF NOT ; GP-V6:31 CMP (SS)+,(SS)+ ; DISCARD ZERO SUBTRAHEND ; GP-V6:31 RTS MP ; GP-V6:31 SUBRL2: ADD #100000,(SS) ;NEGATE REAL ON TOP ; GP-V6:31 CALLSS ADDR ;ADD REALS ENDSBR: RTS MP ;*************************** DIVR ***************************** ; ; REAL DIVIDE: R := A / B ; ; INPUT: ; 6(R5), 4(R5) = A ; 2(R5), (R5) = B ROUTINE DIVR ENDDIVR TST 4(R5) BEQ DVR1 ; A IS ZERO --> NOTHING TO DO TST (R5) ; DENOMINATOR ZERO? BNE DVR2 ; NO, GO ON CALLSS WRERROR .WORD 34.+FATAL ; DIVIDE BY ZERO ERROR DVR1: CMP (R5)+,(R5)+ ; REMOVE B CLR 2(R5) ; ZERO RESULT RTS MP DVR2: CALLSS EXPTOP ; R1 := E(B) (EXPONENT OF B) ; R0(8) := SIGN OF B CALLSS EXPNTOP ; R2 := E(A) ; R0(0) := SIGN OF A MOV R0,-(HP) ; SAVE SIGNS SUB R1,R2 ; E(R) := E(A) - E(B) - 2 SUB #2,R2 MOV R2,-(HP) ; SAVE E(R) MOV R3,-(HP) ; SAVE R3 MOV R4,-(HP) ; SAVE R4 MOV (R5)+,R2 ; LOAD B MOV (R5)+,R3 MOV (R5)+,R0 ; LOAD A MOV (R5),R1 CLR -(R5) ; INITIALIZE RESULT (R) CLR R4 ; DIVIDE A BY B BY SHIFTED SUBTRACTION TO OBTAIN 26 BIT QUOTIENT. ; 26 BITS ARE REQUIRED BECAUSE RESULT FRACTION CAN BE IN RANGE ; 0.5 TO 2.0-SMALLREAL SINCE A AND B ARE IN RANGE 0.5 TO 1.0-SMALLREAL. MOV #26.,-(HP) ; LOOP COUNT DVR3: CMP R0,R2 ;; IF A > B THEN BLO 20$ ;; BHI 10$ ;; CMP R1,R3 ;; BLO 20$ ;; 10$: SUB R3,R1 ;; BEGIN SBC R0 ;; A := A - B ; SUB R2,R0 ;; INC R4 ;; R := R + 1 20$: ;; END; ASL R1 ;; A := A * 2 ; ROL R0 ;; ASL R4 ;; R := R * 2 ROL (R5) ;; DEC (HP) ;; BNE DVR3 ; LOOP TST (HP)+ MOV R4,2(R5) ; SAVE LOW PART OF RESULT CLR R1 ; CARRY REGISTER MOV (HP)+,R4 ; RESTORE R4 MOV (HP)+,R3 ; R3 MOV (HP)+,R2 ; E(R) MOV (HP)+,R0 ; SIGNS CALLSS SIGNS ;SIGN AND NORMALIZE ENDDVR: RTS MP ;******************************* EXPTOP ***************************** ;EXPECTS A REAL AT (R5), 2(R5). ;SIGN AND EXPONENT ARE TAKEN FROM THE REAL AND STORED ;IN R0 AND R1. REAL FRACTION IS LEFT AT (R5), 2(R5) ROUTINE EXPTOP ENDXPT CLR R0 ;CLEAR SIGNS MOV (R5), R1 ASL R1 ROL R0 ; PUT SIGN IN R0 HIGH BYTE ; GP-V6:30 SWAB R0 ; GP-V6:30 CLRB R1 SWAB R1 ;EXPONENT OF SECOND REAL SUB #200, R1 ;PURE EXPONENT CLRB 1(R5) BIS #200, (R5) ;HIDDEN BIT ENDXPT: RTS MP ;***************************** EXPNTOP *************************** ;EXPECTS A REAL AT 4(R5), 6(R5) ;SIGN AND EXPONENT ARE RETURNED IN R0 AND R2 ;REAL FRACTION LEFT AT 4(R5), 6(R5) ROUTINE EXPNTOP ENDXPN MOV 4(R5), R2 ASL R2 ADC R0 ;SIGN OF DESTINATION CLRB R2 SWAB R2 ;EXPONENT SUB #200, R2 CLRB 5(R5) BIS #200, 4(R5) ;HIDDEN BIT ENDXPN: RTS MP ;********************************* FLT **************************** ;REGISTERS USED: R0, R1, R2 ROUTINE FLT ENDFLT CLR R0 ;INIT SIGN REGISTER MOV (SS),-(SS) ;MOVE ONE PLACE BGT FLT1 ;TEST VALUE BEQ ENDFLT NEG (SS) ;NEGATE INTEGER INC R0 ;SIGN < 0 FLT1: MOV #10,R2 ;EXPONENT FLT2: CLR 2(SS) ;CLEAR SECOND WORD CLR R1 ;NO CARRY BIT CALLSS NORM ;NORMALIZE REAL ENDFLT: RTS MP ;******************************* FLO *************************** ROUTINE FLO ENDFLO MOV (SS)+,-(HP) MOV (SS)+,-(HP) ;STORE REAL ON TOP CALLSS FLT ;FLOAT INTEGER ON TOP MOV (HP)+,-(SS) MOV (HP)+,-(SS) ;RESTORE REAL ENDFLO: RTS MP ;*************************** NORM ****************************** ;(NOT NORMALIZED) REAL FRACTION EXPECTED AT (R5), 2(R5) ;BINARY EXPONENT IN R2, SIGN IN R0. R1 CONTAINS CARRY BIT. ;A NORMALIZED REAL IS LEFT IN (R5), 2(R5) ROUTINE NORM ENDNRM ADD #200, R2 ;EXCESS 200 TST (R5) ;FRACTION ZERO? BNE NRM1 ;NO TST 2(R5) ;MAYBE BEQ NRM7 ;YES NRM1: CMP (R5), #400 ;FRACTION OVERFLOW? BPL NRM3 ;YES. NRM2: CMP (R5), #200 ;NORMALIZED? BPL NRM4 ASL R1 ;GET CARRY BIT ROL 2(R5) ;SCALE ROL (R5) ;LEFT DEC R2 ;ADJUST EXPONENT BR NRM2 ;GO AGAIN NRM3: ASR (R5) ;SCALE ROR 2(R5) ;RIGHT ROR R1 ;STORE CARRY BIT INC R2 BR NRM1 NRM4: ASL R1 ;ROUND BCC NRM8 ADC 2(R5) ADC (R5) CLR R1 BR NRM1 ;RENORMALIZE NRM8: CMP R2, #377 ;EXPONENT OVERFLOW? BLE NRM5 ;NO CALLSS WRERROR .BYTE 30.,2 MOV #-1,(R5) MOV (R5),2(R5) ;BIGGEST ABSOLUTE VALUE ASR R0 ROR (R5) ;SIGN RTS MP NRM5: TST R2 ;EXPONENT UNDERFLOW? BPL NRM6 ;NO CALLSS WRERROR .BYTE 31.,2 CLR (R5) CLR 2(R5) ;FLOATING ZERO RTS MP NRM6: BICB #200,(R5) ;REMOVE SIGNIFICANT BIT SWAB R2 ASR R0 ;SIGN ROR R2 ;RIGHT POSITION BIS R2,(R5) ;PACK EXPONENT NRM7: ENDNRM: RTS MP .END **** P11REDSET.MAC .TITLE REDSET ;******************************* REDST **************************** ROUTINE REDST ENDRST MOV (SS)+,(SS) ;MOVE FIRST SET WORD THREE PLACES UP MOV (SS)+,(SS) MOV (SS)+,(SS) ENDRST: RTS MP ;***************************** REDSN ******************************** ROUTINE REDSN ENDRSN MOV (SS)+, 4(SS) ;SHIFT WORD OF SET MOV (SS)+, 4(SS) TST (SS)+ ;REMOVE LAST WORD ENDRSN: RTS MP .END **** P11RESET.MAC .TITLE P11RESET .IDENT '850807' ; ; CORRECTION GP-V6:08 1980-05-31 GP ; CORRECTION GP-V6:26 1980-05-31 GP ; CORRECTION GP-V6:27 1980-05-31 GP ; CORRECTION GP-V6:28 1980-05-31 GP ; CORRECTION GP-V6:34 1980-05-31 GP ; CHANGE GP-V6:45 1980-06-10 GP ; CORRECTION GP-V6:56 1980-06-10 GP ; CORRECTION GP-V6:70 1981-02-01 GP ; CHANGE GP-V6:89 1981-08-13 GP ; CHANGE GP-V6:90 1981-09-16 GP ; CORRECTION GP-V6:94 1984-01-29 GP ; CORRECTION GP-V6:96 1984-03-17 GP ; CHANGE GP-V6:97 1984-03-17 GP ; CORRECTION GP-V6:103 1984-12-30 GP ; CORRECTION GP-V6:107 1985-08-06 GP ; ; .MCALL FDOF$L,CLOSE$,OPEN$,DELET$,ALUN$S FDOF$L ; DEFINE FDB OFFSETS ; ; ; ; REWRITE (F, FNAM, FDIR, FDEV, IOSPEC) ; ; RESET (F, FNAM, FDIR, FDEV, IOSPEC) ; ; 16.(SS) = POINTER TO FILE POINTER ; 14.(SS) = RECORD SIZE ( -1 FOR TEXT FILES ) ; 12.(SS) = ADDRESS OF FNAM STRING ; 10.(SS) = LENGTH OF FNAM STRING (**) ; 8.(SS) = ADDRESS OF FDIR STRING ; 6.(SS) = LENGTH OF FDIR STRING ; 4.(SS) = ADDRRES OF FDEV STRING ; 2.(SS) = LENGTH OF FDEV STRING ; (SS) = IOSPEC ; ; ** NOTE: ; When the user provides none of the strings FNAM, FDIR or FDEV, ; the compiler supplies a string for FNAM (the name of the file ; variable) with a negative length. If the file is already open ; then this means that the user just wants the same file reopened. ; ROUTINE RESET BIC #APPEND+UPDATE,@SS MOV #FO.RD,-(HP) BIS #INPUT,@SS BR RESET1 ROUTINE REWRITE MOV #FO.WRT,-(HP) BIC #INPUT,@SS RESET1: MOV 16.(SS),R ; Search LUNtable for the given file. If found then file already ; exists; if not found then this is a new file. For new files ; find an available LUN (ie. zero entry in LUNtable). 1$: MOV GP,AD CLR -(HP) 2$: CMP R,LUNTBL(AD) BEQ OPN1 ; LUN found TST (AD)+ INC @HP CMP @HP,#MAXFILES+1 BLT 2$ TST R BEQ 3$ ; No free LUN available -- Error ; New file -- clear the FILTYP. It may be allocated over ; GP-V6:08 ; junk on a procedure's stack. ; GP-V6:08 CLR FILTYP(R) ; GP-V6:08 TST (HP)+ ; Remove counter CLR R BR 1$ ; Search for free LUN ; ERROR -- Too many files 3$: MOV 16.(SS),R ; File pointer MOV #-101.,IORESULT(R) MOV #TRUE,EOFSTATUS(R) EX1: ADD #18.,SS TST (HP)+ ; Remove LUN counter TST (HP)+ ; Remove OPEN type code ; V4-22 RETURN ; At this point: ; 2(HP) is open mode (FO.RD or FO.WRT). ; (HP) is the LUN to use for file access. ; If R = 0 then a new file is being opened. ; If R <> 0 then an existing file (already open) file is being reopened. OPN1: TST R BEQ NEWOPEN ; Br if new file ; Existing file being reopened -- close file first REOPEN: MOV R,AR ADD #FDB,AR ; FDB address ; Flush output text file if necessary BIT #TEXT,FILTYP(R) BEQ 10$ ; Br if non-text BIT #INPUT,FILTYP(R) BNE 10$ ; Br if input file CMP 2(R),#TEXTBUFFSIZE ; If output file buffer BEQ 10$ ; is not empty CALLSS PUTL2 ; then output current line. 10$: ; (PUTLN2 corrupts AD) CLR EOFSTATUS(R) ; GP-V6:27 BIT #TTY, FILTYP(R) ; GP-V6:27 BNE EX1 ; Br if TTY file ; GP-V6:27 TST 10.(SS) ; If the RESET/REWRITE statement has BPL 50$ ; a file spec then br ; GP-V6:97 BIT #TEMPORARY,FILTYP(R) ; If file was created as temporary BEQ 14$ ; then BIS #TEMPORARY,@SS ; mark TEMPORARY in current IOSPEC BR 20$ ; and reopen same file. 14$: CMP 2(HP),#FO.WRT ; If REWRITE operation BNE 18$ ; and BIT #UPDATE,@SS ; UPDATE is not specified BEQ 50$ ; then create new file 18$: ; else reopen same file. ; Temporary files and files being reopened without a file spec ; -- save filename block, close then reopen same file. 20$: MOV AR,AD ADD #F.FNB,AD ; Address of filename block of FDB MOV #S.FNB/2,R ; GP-V6:96 30$: MOV (AD)+,-(SS) ; Save FNB SOB R,30$ CLOSE$ MOV #S.FNB/2,R ; GP-V6:96 40$: MOV (SS)+,-(AD) ; Restore FNB so that same file SOB R,40$ ; is reopened. MOV 16.(SS), R ; Restore file pointer ; GP-V6:08 BR NEWOP2 ; GP-V6:08 ; Non-temporary files being reopened with a file spec. ; Close the file without restoring the FNB. 50$: CLOSE$ NEWOPEN: ; At this point: ; (HP) = allocated LUN MOV (HP),AD ; LUN ASL AD ADD GP,AD MOV 16.(SS),R ; File pointer MOV R,LUNTBL(AD) ; Reserve LUN ; Clear the FDB ; (It may be allocated over junk on a procedure's stack) MOV R,AR ; GP-V6:08 ADD #FDB, AR ; FDB address ; GP-V6:08 MOV #S.FDB/2, AD ; Size of FDB in words ; GP-V6:08 2$: CLR (AR)+ ; Clear FDB ; GP-V6:08 SOB AD, 2$ ; Loop ; GP-V6:08 MOV R, AR ADD #FDB, AR ; FDB address NEWOP2: ; GP-V6:08 MOV (HP)+,AD ; Get LUN MOVB AD,F.LUN(AR) ; Set LUN in FDB MOV R,F.URBD+2(AR) ADD #2,F.URBD+2(AR) ; User record buffer address MOV 14.(SS),F.URBD(AR) ; User record buffer length MOVB #R.FIX,F.RTYP(AR); Not text ALUN$S AD,#$P.DEV,#$P.UNI; Assign LUN to default (SY0:) MOV 14.(SS),F.RSIZ(AR); Record size BGT 11$ ; If not textfile ; Init textfile parameters SUB #TEXTBUFFSIZE+FILESIZECORR+2,F.URBD+2(AR) ; ; Point to hidden buffer MOV #TEXTBUFFSIZE,F.URBD(AR) CLR F.RSIZ(AR) MOVB #R.VAR,F.RTYP(AR) BIS #TEXT,@SS ; Set TEXT in iospec MOVB #FD.PLC,F.RACC(AR); Locate mode BIT #FDFTN,(SS) ; If caller wants first byte of each ;GP-V6:94 BEQ 8$ ; record to be FORTRAN VFC then ;GP-V6:94 MOVB #FD.FTN,F.RATT(AR) ; set FD.FTN record attribute. ;GP-V6:94 BR 10$ ;GP-V6:94 8$: BIT #NOCR,(SS) ; If user does'nt want newlines between BNE 10$ ; records then set null record attributes MOVB #FD.CR,F.RATT(AR) ; otherwise set FD.CR attribute. 10$: 11$: ; Setup for random files BIT #RANDOM,@SS BEQ 15$ ; Br if random not specified BISB #FD.BLK,F.RATT(AR) ; Records may not ; cross block boundaries BISB #FD.RAN,F.RACC(AR) ; Random access mode 15$: BIT #UPDATE,@SS ; If UPDATE specified BEQ 20$ ; then MOV #FO.UPD,(HP) ; change FO.WRT to FO.UPD BIT #INSERT,@SS ; and if INSERT also specified BEQ 17$ ; then BISB #FD.RAN,F.RACC(AR) ; use random access mode. 17$: BR 25$ 20$: ; Not UPDATE BIT #APPEND,@SS ; If APPEND spcified BEQ 25$ ; then MOV #FO.APD,(HP) ; change FO.WRT to FO.APD 25$: BIT #SHARED,@SS ; If SHARED specified BEQ 30$ ; then BIS #FA.SHR,(HP) ; use shared access. 30$: BIT #SPOOL,(SS) ; No temp if SPOOL BNE 31$ BIT #TEMPORARY,@SS BEQ 31$ BIS #FA.TMP,(HP) 31$: ; Prepare filename, directory and device strings: ; 1. Remove trailing blanks ; 2. Convert lowercase to uppercase TST 10.(SS) ; If filename string length ; GP-V6:97 BGE 40$ ; was negative then ; GP-V6:97 NEG 10.(SS) ; make it positive ; GP-V6:97 40$: MOV R,-(HP) ; Save register MOV SS,R ADD #14.,R ; Point above filename address 42$: MOV -(R),AD ; Address of filename string CMP R,SS BLOS 47$ ; Br if three strings done TST -(R) ; String given ? BEQ 42$ ; No ADD (R),AD ; Length of string 43$: CMPB -(AD),#40 BGT 44$ ; If char > space DEC (R) ; Adjust string len if space or less BGT 43$ 44$: INC AD MOV (R),-(HP) ; Temp counter for 45$: DEC @HP ; converting lowercase BLT 46$ ; to upper case CMPB -(AD),#137 BLE 45$ BICB #40,@AD BR 45$ 46$: TST (HP)+ ; Remove temp counter BR 42$ ; Loop 47$: MOV (HP)+,R ; Restore register MOV (HP)+,AD ; File access word CLR EOFSTATUS(R) MOV (SS)+,FILTYP(R) ; Modified IOSPEC into FILTYP ; Open the file via FCS. ; ; FDB addr in AR, file access in AD, dataset desc. addr in SS OPEN$ ,AD,,SS MOVB F.ERR(AR),AD ; I/O error code, sign extended MOV AD,IORESULT(R) BGT 50$ ; If file did not open successfully INC EOFSTATUS(R) ; then set EOF(F) MOVB F.LUN(AR), AD ; GP-V6:28 ASL AD ; GP-V6:28 ADD GP,AD ; GP-V6:28 CLR LUNTBL(AD) ; Release LUN in LUNTABLE ; GP-V6:28 50$: ADD #16.,SS ; Release all parameters BIT #INPUT+UPDATE,FILTYP(R) ; If read or update BEQ 52$ ; and TST EOFSTATUS(R) ; file opened ok BNE 59$ ; then JMP $GET1 ; get first record and return. 52$: ; For write-only file ; BIS #TRUE,EOFSTATUS(R) ; EOF(F) := TRUE CLR EOLNSTATUS(R) ; EOLN(F) := FALSE MOV F.NRBD+2(AR),@R BNE 55$ ; V4-16 MOV F.URBD+2(AR),@R ; V4-16 55$: ; V4-16 BIT #TEXT,FILTYP(R) BEQ 59$ ; Br if not text file MOV F.NRBD(AR),2(R) BNE 59$ MOV F.URBD(AR),2(R) 59$: RETURN ; .END **** P11REXP.MAC .TITLE REXP ;*************************** REXP ******************************* ;REXP EXPECTS A REAL X ON TOP OF THE STACK AT (SS), 2(SS) ;EXP(X) IS RETURNED IN (SS), 2(SS) ;REGISTER USE: ALL ROUTINE REXP ENDEXP MOV #125073,-(SS) MOV #040270,-(SS) ;LOAD LOG2(E) CALLSS MULR ;X * LOG2(E) MOV 2(SS),-(SS) MOV 2(SS),-(SS) ;COPY X * LOG2(E) ON THE STACK CALLSS TRC ;TRUNCATE: INT(X * LOG2(E)) ON STACK MOV (SS),-(HP) ;STORE INTEGER PART CALLSS FLT ;FLOAT INTEGER FOR SUBTRACTION CALLSS SUBR ;FRACTION(X * LOG2(E)) = ;X * LOG2(E) - INT(X * LOG2(E)) MOV #125073,-(SS) MOV #040470,-(SS) ;LOAD 2*LOG2(E) CALLSS DIVR ;Y := FRACTION(X * LOG2(E))/(2 * LOG2(E)) TST (SS) ;EQUAL? BNE EX0 ;NO --> USUAL CONTINUATION CLR 2(SS) MOV #040200,(SS) ;MAKE RESULT 1.0 BR EX1 ;CONTINUE EX0: MOV 2(SS),-(SS) MOV 2(SS),-(SS) ;LOAD COPY OF Y IN ADVANCE MOV #071571,-(SS) MOV #042426,-(SS) ;LOAD A1 = 601.8042667 FOR LATER USE MOV 6(SS),-(SS) MOV 6(SS),-(SS) ;LOAD ANOTHER COPY OF Y CALLSS SQRR ;Y * Y ON TOP OF STACK MOV #056133,-(SS) MOV #041560,-(SS) ;LOAD B1 = 60.0901907 CALLSS ADDR ;B1 + Y * Y CALLSS DIVR ;DIVIDE: A1/(B1 + Y * Y) MOV #036602,-(SS) MOV #141100,-(SS) ;LOAD A0 = -12.01501675 CALLSS ADDR ;A0 + A1/(B1 + Y * Y) CALLSS ADDR ;A0 + Y + A1/(B1 + Y * Y) CALLSS DIVR ;Y/(A0 + Y + A1/(B1 + Y * Y)) CLR -(SS) MOV #140400,-(SS) ;LOAD -2.0 CALLSS MULR ;-2.0 * Y/(. . . CLR -(SS) MOV #040200,-(SS) ;LOAD 1.0 CALLSS ADDR ;1 - 2 * Y/( . . CALLSS SQRR ;SQUARE(1 - 2 * Y/( . . . ) EX1: MOV (HP)+,R0 ;RESTORE INTEGER PART SWAB R0 CLRB R0 ASR R0 ;MAKE EXPONENT ADD R0,(SS) ;ADD EXPONENT MODIFIER BMI EX2 ;OVERFLOW RTS MP EX2: CALLSS WRERROR ;WRITE ERROR MESSAGE .BYTE 50.,2 MOV #-1,2(SS) MOV #077777,(SS) ;BIGGEST POSSIBLE VALUE TAKEN ENDEXP: RTS MP .END **** P11RLOG.MAC .TITLE RLOG ;********************************* RLOG ************************************ ;RLOG EXPECTS A REAL AT (SS), 2(SS) AND RETURNS THE ;LOGARITHM OF THIS VALUE IN THE SAME PLACE ;REGISTER USE: ALL ROUTINE RLOG ENDLOG MOV MP,-(HP) ;STORE MP MOV PC, MP LOGL$: ADD #LOGTAB+4-LOGL$,MP ;MP POINTS IN THE LOGTABLE MOV (SS),-(SS) ;EXPONENT PART ROL (SS) CLRB (SS) SWAB (SS) SUB #200,(SS) ;BINARY EXPONENT CALLSS FLT ;FLOAT EXPONENT MOV -(MP),-(SS) MOV -(MP),-(SS) ;LOAD LN(2) CALLSS MULR ;AND MULTIPLY EXPONENT WITH LN(2) MOV (SS)+,-(HP) MOV (SS)+,-(HP) ;STORE EXP * LN(2) LDEXP: ASL (SS) ;REMOVE SIGN ROL -(HP) ;STORE SIGN BIT MOVB #200, 1(SS) ;LOAD EXPONENT ASR (HP)+ ;GET SIGN ROR (SS) ;INSERT SIGN ;ZERO EXPONENT --> REAL BETWEEN .5 AND 1.0 MOV (SS),-(HP) MOV 2(SS),-(HP) ;STORE COPY OF X MOV -(MP),-(SS) MOV -(MP),-(SS) ;LOAD 1/2 * SQRT(2) CALLSS SUBR ;X - 1/2 * SQRT(2) MOV (HP)+,-(SS) MOV (HP)+,-(SS) ;LOAD X MOV 2(MP),-(SS) MOV (MP),-(SS) ;LOAD 1/2 * SQRT(2) CALLSS ADDR ;X + 1/2 * SQRT(2) CALLSS DIVR ;W := (X - 1/2 * SQRT(2))/(X + 1/2 * SQRT(2)) MOV 2(SS),-(SS) MOV 2(SS),-(SS) ;TEMPORARY STORE OF W CALLSS SQRR ;SQUARE Y := W * W MOV 2(SS),-(SS) MOV 2(SS),-(SS) ;LOAD COPY OF Y MOV 2(SS),-(SS) MOV 2(SS),-(SS) ;AND A SECOND ONE MOV #3,-(HP) ;INITIALIZE COUNTER MOV -(MP),-(SS) MOV -(MP),-(SS) ;LOAD C1 INITIATE R LOGL8: CALLSS MULR ;R := R * Y MOV -(MP),-(SS) MOV -(MP),-(SS) ;LOAD C2 CALLSS ADDR ;R := R + LOGTAB[I] DEC (HP) ;DECREMENT COUNTER BGT LOGL8 TST (HP)+ ;REMOVE COUNT CALLSS MULR ;R := R * W MOV -(MP),-(SS) MOV -(MP),-(SS) ;LOAD -1/2 * LN(2) CALLSS ADDR ;R := R - 1/2 * LN(2) MOV (HP)+,-(SS) MOV (HP)+,-(SS) ;LOAD EXP * LN(2) CALLSS ADDR ;ADD SCALE FACTOR MOV (HP)+,MP ;RESTORE MP RTS MP .FLT2 -.34657359 ;-1/2 * LN(2) .FLT2 2.00000000 ;2 .FLT2 .66666667 ;C[3] .FLT2 .39965910 ;C[2] .FLT2 .30097451 ;C[1] .FLT2 .70710678 ;1/2 * SQRT(2) LOGTAB: .FLT2 .69314718 ;LN(2) ENDLOG = LOGTAB+2 .END **** P11RSQRT.MAC .TITLE RSQRT ;************************************* RSQRT ********************************** ROUTINE RSQRT ENDSQT TST (SS) ;TEST IF EQUAL BEQ ENDSQT ;EASY JOB BGT SQ1 ;ARGUMENT MUST BE >= 0 CALLSS WRERROR .BYTE 51.,1 ;POSSIBLE RETURN WITH ZERO RESULT CLR 2(SS) CLR (SS) ;ZERO RESULT RTS MP SQ1: MOV 2(SS),-(SS) MOV 2(SS),-(SS) ;LOAD COPY OF X ASR (SS) ADD #020100,(SS) ;INITIAL ESTIMATE E MOV #3,-(HP) ;SET ITERATION COUNT SQ2: MOV 6(SS),-(SS) MOV 6(SS),-(SS) ;LOAD COPY OF X MOV 6(SS),-(SS) MOV 6(SS),-(SS) ;LOAD COPY OF E CALLSS DIVR ;X/E CALLSS ADDR ;X/E + E CLR -(SS) MOV #040400,-(SS) ;LOAD 2.0 CALLSS DIVR ;(X/E + E)/2 DEC (HP) ;DECREMENT ITERATION COUNT BGT SQ2 TST (HP)+ ;DELETE COUNT MOV (SS)+,2(SS) MOV (SS)+,2(SS) ;REMOVE X AND LOAD RESULT ENDSQT: RTS MP .END **** P11RSTRNC.MAC .TITLE RUNCHK (P11RSTRNC) .IDENT '840317' ; CHANGE GP-V6:16 80-05-30 GP ; CHANGE GP-V6:17 80-05-30 GP ; CHANGE GP-V6:71 81-02-01 GP ; CORRECTION GP-V6:99 84-03-17 GP ;**************************************************** ;**************************************************** ;************ ************ ;************ FOR RSX EMULATOR ON RSTS ************ ;************ ************ ;**************************************************** ;**************************************************** ;******************************** SUBSTRCHECK *********************** ; ; INPUTS: ; 6(SS) - LOWER BOUND OF SUBSTRING (LB) ; 4(SS) - UPPER BOUND OF SUBSTRING (UB) ; 2(SS) - LOWEST ARRAY INDEX (LMIN) ; 0(SS) - HIGHEST ARRAY INDEX (LMAX) ; ; OUTPUT: ; LMIN & LMAX REMOVED FROM STACK ; ROUTINE STRCH SUBSTRCHECK MOV 6(SS),R0 ; LB DEC R0 ; LB-1 CMP 4(SS),R0 ; COMPARE LB-1 : UB BLT 20$ ; LB-1 < UB --> ERROR BEQ 10$ ; LB-1 = UB --> ZERO LENGTH SUBSTRING CMP (SS)+,2(SS) ; COMPARE LMAX : UB BLT 22$ ; UB > LMAX --> ERROR CMP (SS)+,2(SS) ; COMPARE LMIN : LB BGT 24$ ; LB < LMIN --> ERROR 9$: RTS MP ; RETURN 10$: CMP (SS)+,(SS)+ ; REMOVE LB, UB BR 9$ 20$: TST (SS)+ 22$: TST (SS)+ 24$: CALLSS WRERROR .WORD 60.+FATAL BR 9$ ;******************************* STRINGINDEX ********** ROUTINE STIND STRINGINDEX CMP 2(SS),(SS) ;COMPARE INDEX TO SIZE BLE STI1 ;ERROR TST (SS) ;TEST IF >= 0 BGE STI2 ;YES, READY STI1: CALLSS WRERROR .WORD 61.+FATAL STI2: ENDSTI: RTS MP ;*************************** OVFLCHK ***************************** ; ; STACK AND HEAP OVERFLOW CHECK. ; ; THIS IS A SPECIAL VERSION FOR PROGRAMS RUNNING UNDER RSX ; EMULATOR ON RSTS OPERATING SYSTEM. ; ROUTINE OVFLCHK ENDOFC MOV DAPADDR(GP), AR ;AR := DAP ADD #80., AR ;KEEP FREE STORE OF 40 WORDS CMP SS, AR ;SS > AR? BHI OFC0 ;YES, CONTINUE CALLSS WRERROR .WORD 10.+FATAL OFC0: CMP HP, #1050 ; CHECK STACK OVERFLOW (WITH RESERVE) BHI ENDOFC ; BR IF NO OVERFLOW CALLSS WRERROR .WORD 11.+FATAL ENDOFC: RTS MP ;******************************* SUBRCHK ******************************* ROUTINE SUBRCHK ENDSCK CMP (SS), (MP)+ ;LOWER BOUND BLT SCKL2 CMP (SS), (MP)+ ;UPPER BOUND BLE SCK0 SCKL1: MOV @SS,-(SS) ; OFFENDING VALUE MOV #1,-(SS) ; 1 PARAM ON STACK CALLSS WRERROR .WORD 12.+FATAL+ERPARM ; GP-V6:17 SCK0: RTS MP SCKL2: TST (MP)+ ;REMOVE SECOND ARGUMENT ENDSCK: BR SCKL1 .END **** P11RUNCHK.MAC .TITLE RUNCHK .IDENT '810808' ; CHANGE GP-V6:16 80-05-30 GP ; CHANGE GP-V6:17 80-05-30 GP ; CHANGE GP-V6:71 81-02-01 GP ;******************************** SUBSTRCHECK *********************** ; ; INPUTS: ; 6(SS) - LOWER BOUND OF SUBSTRING (LB) ; 4(SS) - UPPER BOUND OF SUBSTRING (UB) ; 2(SS) - LOWEST ARRAY INDEX (LMIN) ; 0(SS) - HIGHEST ARRAY INDEX (LMAX) ; ; OUTPUT: ; LMIN & LMAX REMOVED FROM STACK ; ROUTINE STRCH SUBSTRCHECK MOV 6(SS),R0 ; LB DEC R0 ; LB-1 CMP 4(SS),R0 ; COMPARE LB-1 : UB BLT 20$ ; LB-1 < UB --> ERROR BEQ 10$ ; LB-1 = UB --> ZERO LENGTH SUBSTRING CMP (SS)+,2(SS) ; COMPARE LMAX : UB BLT 22$ ; UB > LMAX --> ERROR CMP (SS)+,2(SS) ; COMPARE LMIN : LB BGT 24$ ; LB < LMIN --> ERROR 9$: RTS MP ; RETURN 10$: CMP (SS)+,(SS)+ ; REMOVE LB, UB BR 9$ 20$: TST (SS)+ 22$: TST (SS)+ 24$: CALLSS WRERROR .WORD 60.+FATAL BR 9$ ;******************************* STRINGINDEX ********** ROUTINE STIND STRINGINDEX CMP 2(SS),(SS) ;COMPARE INDEX TO SIZE BLE STI1 ;ERROR TST (SS) ;TEST IF >= 0 BGE STI2 ;YES, READY STI1: CALLSS WRERROR .WORD 61.+FATAL STI2: ENDSTI: RTS MP ;*************************** OVFLCHK ***************************** ROUTINE OVFLCHK ENDOFC MOV DAPADDR(GP), AR ;AR := DAP ADD #80., AR ;KEEP FREE STORE OF 40 WORDS CMP SS, AR ;SS > AR? BHI OFC0 ;YES, CONTINUE CALLSS WRERROR .WORD 10.+FATAL OFC0: MOV @#2, AR ;CHECK FOR HARDWARE STACKOVFL ADD #40., AR ; 20 WORDS ; GP-V6:16 CMP HP, AR BHI ENDOFC CALLSS WRERROR .WORD 11.+FATAL ENDOFC: RTS MP ;******************************* SUBRCHK ******************************* ROUTINE SUBRCHK ENDSCK CMP (SS), (MP)+ ;LOWER BOUND BLT SCKL2 CMP (SS), (MP)+ ;UPPER BOUND BLE SCK0 SCKL1: MOV @SS,-(SS) ; OFFENDING VALUE MOV #1,-(SS) ; 1 PARAM ON STACK CALLSS WRERROR .WORD 12.+FATAL+ERPARM ; GP-V6:17 SCK0: RTS MP SCKL2: TST (MP)+ ;REMOVE SECOND ARGUMENT ENDSCK: BR SCKL1 .END **** P11SGSIN.MAC .TITLE SGSIN ;****************************** SGSIN *************************** ROUTINE SGSIN ENDSGS MOV (SS)+, R ;ORDINAL NUMBER OF SETELEMENT IN R MOV R, AR ;COPY R IN AR BIC #177770, AR ;AR := AR MOD 8 ASR R ASR R ASR R ;R := R DIV 8 ADD SS, R ;R NOW CONTAINS BYTE ADDRESS (IN SET) ADD PC, AR ;CALCULATE ADDRESS OF BYTE MASK IN AR BISB 6(AR),(R) ;SET BIT IN SET ON STACK RTS MP .WORD 001001 ;BYTE MASK TABLE .WORD 004004 ; .WORD 020020 ENDSGS: .WORD 100100 .END **** P11SINCOS.MAC .TITLE SINCOS ; ; CORRECTION V5-21 1979-06-19 STD ; ;******************************** RSIN ****************************** ROUTINE RSIN ENDSIN MOV MP,-(HP) ;STORE MP MOV PC, MP ;INITIATE MP SINT$: ADD #SINTAB+4-SINT$,MP ;MP USED AS TABLE POINTER CLR -(HP) ;SIGN FLAG TST (SS) ;SIGN OF ARGUMENT X BPL SIN1 BIC #100000,(SS) ;MAKE X PLUS DEC (HP) ;SET SIGN FLAG SIN1: MOV -(MP),-(SS) MOV -(MP),-(SS) ;LOAD PI/2 CALLSS DIVR ;X/(PI/2) CLR -(SS) MOV #37600,-(SS) ;LOAD 0.25 CALLSS MULR ;0.25 * X/(PI/2) =X/2PI MOV 2(SS),-(SS) MOV 2(SS),-(SS) ;LOAD COPY OF X/2PI CALLSS TRC ;TRUNCATE FOR FRACTION CALLSS FLT ;FLOAT CALLSS SUBR ;FRACTION(X/2PI) TST (SS) ;ZERO? BEQ SIN6 ;YES, READY CLR -(SS) MOV #40600,-(SS) ;LOAD 4.0 CALLSS MULR ;4.0 * FRACTION MOV 2(SS),-(SS) MOV 2(SS),-(SS) ;COPY CALLSS TRC ;TRUNCATE: INT(4.0 * FRACTION) MOV (SS),-(HP) ;STORE CALLSS FLT ;FLOAT CALLSS SUBR ;FRACTION(4.0 * FRACTION(X/2PI)) ROR (HP) ;EVEN? BCC SIN2 ;YES TST (SS) ;ZERO? ; V5-21 BEQ SIN11 ;YES, AVOID -0.0 ; V5-21 ADD #100000,(SS) ;NO, NEGF SIN11: CLR -(SS) MOV #040200,-(SS) ;LOAD 1.0 CALLSS ADDR ;Y := 1 - Y SIN2: ROR (HP)+ ;TEST IF FIRST/SECOND QUADR, AND REMOVE BCC SIN3 ;YES, IN 1ST OR 2ND ADD #100000,(SS) ;Y := -Y SIN3: MOV 2(SS),-(SS) MOV 2(SS),-(SS) ;COPY Y CALLSS SQRR ;Y * Y MOV #4,-(HP) ;INITIALIZE COUNT MOV (SS)+,-(HP) MOV (SS)+,-(HP) ;STORE COPY OF Y * Y MOV -(MP),-(SS) MOV -(MP),-(SS) ;LOAD SINTAB[1] SIN5: MOV (HP),-(SS) MOV 2(HP),-(SS) ;LOAD Y * Y CALLSS MULR MOV -(MP),-(SS) MOV -(MP),-(SS) ;LOAD SINTAB[I] AND INITIATE RES CALLSS ADDR ;RES := RES * Z + SINTAB[I] DEC 4(HP) ;DECREMENT COUNT BGT SIN5 ;LOOP ADD #6, HP ;REMOVE COUNT AND Y * Y COPY CALLSS MULR ;RESULT := RES * X SIN6: TST (HP)+ ;TEST SIGN BEQ SIN4 ;>= 0 ADD #100000,(SS) ;NEGATE SIGN SIN4: MOV (HP)+, MP ;RESTORE MP RTS MP .FLT2 1.57079632 ;TABLE OF COEFFICIENTS .FLT2 -.64596371 .FLT2 .07968968 .FLT2 -.00467377 .FLT2 .00015148 SINTAB: .FLT2 1.57079632 ;PI/2 ENDSIN = SINTAB+2 ;********************************* RCOS ****************************** ROUTINE RCOS ENDCOS MOV #007733,-(SS) MOV #040311,-(SS) ;LOAD PI/2 CALLSS ADDR ;X + 1/2PI CALLSS RSIN ;SIN ENDCOS: RTS MP .END **** P11SPLTRL.MAC .TITLE SPLTRL ;******************************* SPLTRL ******************************* ROUTINE SPTRL ENDSPR MOV (SS)+, R1 ;ADDRESS OF RESULT PARAMETER MOV (SS), R2 ;LOW WORD OF (VALUE) REAL PARAMETER ASL R2 ;REMOVE SIGN SWAB R2 ;GET EXPONENT IN LOW BYTE OF R2 BIC #177400, R2 ;CLEAR HIGH BYTE OF R2 SUB #200, R2 ;PURE EXPONENT MOV R2, (R1) ;STORE EXPONENT BIC #77600, (SS) ;CLEAR EXPONENT PART OF REAL BIS #40000, (SS) ;ZERO EXPONENT --> RESULT ON STACK ENDSPR: RTS MP .END **** P11TRACE.MAC .TITLE $P.TRC ; ; .MCALL QIO$S,WTSE$S ; ROUTINE P.TRC MOV 2(MP),R1 ; LINE NO MOV SS,R0 MOV #20040,-(R0) MOV #20040,-(R0) MOV #20040,-(R0) CLR R2 ; SUPPRESS ZEROES CALL $CBDMG ; CONV BIN TO DEC MAGN CLR R1 ; MOV SS,R0 SUB #6,R0 INCB SELECT+1(R3) ; 10 NUMBERS / LINE CMPB SELECT+1(R3),#1 BEQ 1$ ; FIRST NUMBER IN A LINE CMPB SELECT+1(R3),#10. BNE 2$ ; NOT THE LAST NUMBER CLRB SELECT+1(R3) ; LAST IN A LINE MOV #'+,R1 ; BR 2$ 1$: MOV #'$,R1 ; 2$: QIO$S #IO.WVB,#5,#5,,,, WTSE$S #5 RETURN ; ; .END **** P11TWPOW.MAC .TITLE TWPOW ;******************************* TWPOW ****************************** ROUTINE TWPOW ENDTWP MOV (SS)+, R1 ;LOAD PARAMETER (EXPONENT) ADD #201, R1 ;MAKE EXPONENT IN EXCESS 128 CLR -(SS) CLR -(SS) ;INITIATE RESULT ON STACK MOVB R1, 1(SS) ;STORE EXPONENT ASR (SS) ;CORRECT PLACE BIC #100000,(SS) ;SIGN BIT 0 ENDTWP: RTS MP .END **** P11UNI4.MAC .TITLE UNI4 ;****************************** UNI4 ******************************** ROUTINE UNI4 ENDUNI MOV SS, AD ;CALCULATE SET ADDRESSES IN SS AND AD ADD #8., AD ; BIS (SS)+,(AD)+ ;PERFORM 'OR' FUNCTION ON BIS (SS)+,(AD)+ ;CORRESSONDING WORDS OF THE SET BIS (SS)+,(AD)+ BIS (SS)+,(AD)+ ENDUNI: RTS MP .END **** P11WRBOOL.MAC .TITLE WRBOOL ; ROUTINE WRB MOV #6,-(SS) BR WRB1 ; ROUTINE WRBFX WRB1: TST 2(SS) ; BOOLEAN BEQ 1$ ; IF FALSE MOV #TRU,2(SS) BR 2$ 1$: MOV #FAL,2(SS) 2$: MOV #6,-(SS) ; STRING LENGTH CALLSS WRS RETURN ; TRU: .ASCII /TRUE / FAL: .ASCII /FALSE / .EVEN ; .END **** P11WRERR.MAC .TITLE WRERROR .IDENT '810808' ; CORRECTION V5-41 1979-06-01 STD ; CORRECTION V6-3 1979-09-20 STD ; CHANGE GP-V6:72 1981-02-24 GP ; CHANGE GP-V6:87 1981-08-08 .MCALL QIO$S,WTSE$S ; WRERROR ; ; MP = ADDRESS OF ERROR BYTES ; ; BYTE 1 : ERROR NUMBER ; BYTE 2 : ERROR TYPE ; 0 WARNING ; 1 FATAL ERROR ; 2 SERIOUS ; 4 MESSAGE ; +128. IF PARAMETERS ON SS ; ; ; IF ERROR BYTE 2 > 127. THEN SS DELIVERS PARAMETERS (MAXIMUM OF 3): ; ; M*2(SS) PARAM NR M ; M*2-2(SS) PARAM NR M-1 ; - - - ; 4(SS) PARAM NR 2 ; 2(SS) PARAM NR 1 ; (SS) M = NUMBER OF PARAMETERS ON SS ; ROUTINE WRERROR TST (MP) ; TEST TYPE BYTE BLT 1$ ; PARAMS ON SS CLR -(SS) 1$: MOV @SS,-(SS) ; PARAM COUNTER MOV LINEADDR(GP),2(SS) ; 1ST PARAM = LINENO INC @SS BIT #FATAL,@MP ; V4-32 BNE 7$ ; FATAL ERROR ; V4-32 BIT #MESSAGE,@MP BEQ 20$ ; NOT A MESSAGE ; V5-0 BIT #MPRINT,SELECTOR(GP) ; V5-0 BEQ 21$ ; DON'T PRINT MESSAGE ; V5-0 BR 7$ ; V5-0 20$: ; V5-0 BIT #WPRINT,SELECTOR(GP) ; V4-32 BNE 7$ ; PRINT WARNING ; V4-32 21$: ; V5-0 ASL @SS ADD @SS,SS ; REMOVE PARAMETERS ; V4-32 TST (SS)+ ; "- BR 99$ ; CONTINUE ; V4-32 7$: MOV #TENPOW,R ; V4-32 MOV SS,AD ; V4-32 MOV #TENPOW-WREMSG,AR ; V4-32 6$: MOVB -(R),-(AD) ; MOVE TEMPLATE TEXT TO STACK ; V4-32 DEC AR ; V4-32 BGT 6$ ; V4-32 MOV AD,-(HP) ; SAVE TEXT POINTER ; V4-32 ADD #WRENUM-WREMSG,AD ; V4-32 MOVB @MP,R ; ERROR NUMBER ; V4-32 MOV #TENPOW+6,AR ; ERROR NO < 100. BR 8$ 2$: MOV #TENPOW,AR 8$: MOVB #60,(AD) 3$: SUB @AR,R BLT 4$ INCB @AD BR 3$ 4$: TSTB (AD)+ ADD (AR)+,R TST (AR) BNE 8$ DEC (SS) BLT 9$ ; NO MORE PARAMS MOVB #40,(AD)+ ; INSERT SPACE ; V5-41 MOV 2(SS),R ; NEXT PARAM BGE 50$ ; IF POSITIVE ; V5-41 MOVB #'-,(AD)+ ; INSERT SIGN ; V5-41 NEG R ; CONVERT TO POS ; V5-41 50$: MOV (SS)+,(SS) ; MOV PARAM COUNTER ; V5-41 BR 2$ 9$: SUB @HP,AD ; V4-32 MOV (HP)+,R ; V4-32 QIO$S #IO.WVB,#5,#5,,,, ; V4-32 WTSE$S #5 TST (SS)+ ; REMOVE PARAM COUNTER TST SELECTOR(GP) ; V6-3 BPL 12$ ; V6-3 MOV MP,-(HP) ; SAVE RETURN LINK ; V6-3 MOV GP,MP ; SET MP FOR DEBUGGER ; V6-3, V6-27? TRAP 2 ; CALL DEBUGGER ; V6-3 MOV (HP)+,MP ; RESTORE MP ; V6-3 12$: ; V6-3 99$: MOV (MP)+,R ; ERROR BYTES ; V4-32, V6-26 BIT #SERCONT,SELECTOR(GP) BNE 10$ ; IF CONT AFTER SERIOUS BIT #MESSAGE,R ; V5-0 BNE 10$ ; V5-0 BIT #FATAL,R ; V5-0 BNE 201$ ; IF SERIOUS BIT #WCONT,SELECTOR(GP) BEQ 202$ ; IF NOT CONT AFTER WARNING 10$: RETURN 201$: MOV #EX$ERR,-(SS) ; USE ERROR EXIT STATUS BR 209$ 202$: MOV #EX$WAR,-(SS) ; USE WARNING EXIT STATUS 209$: JMP @EXITP(GP) ; $EXITP OR $EXITN WREMSG: .ASCII /PASRUN -- ERROR / WRENUM: .ASCII /00 00000 00000 00000 00000/ .EVEN TENPOW: .WORD 10000.,1000.,100.,10.,1,0 .END **** P11WRI.MAC .TITLE WRI ;**************************** WRI ************************************* ; 4(SS) FILE ; 2(SS) INTEGER ; (SS) FIELD LENGTH ; ROUTINE WRI ENDWRI MOV (SS)+,-(HP) ;MOVE FIELDLENGTH ONTO HARDWARE STACK CLR -(HP) ;SIGN FLAG ; V4-31 MOV (SS)+, R ;LOAD INTEGER VALUE INTO R BGE WRI0 ;JUMP IF POSITIVE OR ZERO MOV #'-,(HP) ;MOVE '-' ONTO STACK,OVERWRITING THE BLANK NEG R ;INVERT SIGN BVC WRI0 ;JUMP IF NO CARRY OCCURRED (BY -32768) MOV SS, AR MOV AR,-(SS) ;LOAD RETURN VALUE OF SS TST (HP)+ ;REMOVE SIGN CHAR MOV PC,AR ;ACTIONS IN ORDER TO WRITE -32768 ADD #14.,AR ; MOV #6.,AD ;LENGTH IN AD MOV 2(SS),-(SS) ;FILE ID BR WRI1 ; .ASCII /-32768/ WRI0: MOV SS,-(HP) ;LOAD RETURN VALUE OF STACKPOINTER MOV SS, AR ;STARTADDRESS OF INTEGER (STRING) SUB #6, SS ;ROOM FOR STRING (6 BYTES) WRI2: MOV AR,-(HP) ;STORE STRINGADDRESS MOV R,-(SS) ;LOAD NUMERATOR MOV #10.,-(SS) ;LOAD DENOMINATOR CALLSS DIVI ;DIVIDE MOV (SS)+,AD ;QUOTIENT ADD #60, R ;CONVERT REMAINDER TO CHAR MOV (HP)+, AR ;RESTORE SS MOVB R,-(AR) ;COMPOSE STRING MOV AD, R ; BNE WRI2 MOV (HP)+,AD ;RETURN VALUE FOR SS MOV (HP)+,R ;SIGN BEQ 1$ ; IF POSITIVE ; V4-31 MOVB R,-(AR) ; 1$: MOV AD,-(SS) ;RETURN VALUE OF SS ; V4-31 MOV (AD),-(SS) ;FILE ID SUB AR, AD ;AD = STRINGLENGTH WRI1: MOV AR,-(SS) ;LOAD STRINGADDRESS MOV (HP)+,-(SS) ;FIELDLENGTH CMP AD,(SS) BLE WRI3 MOV AD,(SS) WRI3: MOV AD,-(SS) ;LOAD STRINGLENGTH CALLSS WRS ;WRITE THE STRING (NUMBER) MOV 2(SS), SS ;REMOVE STRING ENDWRI: RTS MP .END **** P11WROCT.MAC .TITLE WROCT ; ; ; ; WRITE(F,I:N:O) (* WRITE OCTAL *) ; ; 4(SS) = FILE POINTER ; 2(SS) = INTEGER ; (SS) = FIELD LENGTH ; ROUTINE WROCT ; MOV 4(SS),AD CMP @SS,2(AD) ; SPACE ENOUGH IN CURRENT LINE ? BLE 2$ ; YES MOV AD,-(SS) ; NO. TAKE NEW LINE ( CR-LF ) CALLSS PUTLN 2$: MOV (SS)+,AR ; FIELD LEN MOV (SS)+,-(HP) ; INTEGER MOV AR,-(HP) SUB #6,AR BLE 1$ ; <= 6 OCTAL DIGITS WANTED SUB AR,@HP ; 6 DIGITS AND MOV AR,-(HP) ; SPACE COUNTER 3$: MOV #' ,-(SS) ; WRITE CALLSS WRC ; PRECEDING SPACES DEC @HP BGT 3$ TST (HP)+ ; REMOVE COUNTER 1$: MOV #6,-(HP) ; COUNTER CLR -(SS) ; PRESUMPTIVE DIGIT BR 20$ ; 1ST DIGIT ONLY ONE SHIFT 10$: ASL 4(HP) ; SHIFT 3 BITS TO (SS) ROL (SS) ASL 4(HP) ROL (SS) 20$: ASL 4(HP) ROL (SS) CMP @HP,2(HP) ; THIS DIGIT WANTED ? BGT 40$ ; NEVER PRINT UNWANTED DIGITS ADD #60,@SS ; ASCII CHAR FOR DIGIT CALLSS WRC ; PRINT DIGIT TST -(SS) ; RESERV SPACE FOR NEXT DIGIT 40$: CLR (SS) DEC @HP BGT 10$ ; IF NOT READY TST (SS)+ ADD #6,HP ; REMOVE TEMPS RETURN ; .END **** P11WRREAL.MAC .TITLE WRREAL ; CORRECTION V4-14 1977-06-15 OEN ; CORRECTION V5-8 1978-11-21 STD ; CORRECTION V5-10 1978-11-21 STD ; ;****************************** WRR ******************************** ;WRITE THE REAL IN 2(SS), 4(SS) IN FLOATING FORMAT ;FIELDLENGTH IN (SS), FILE IN 6(SS) ROUTINE WRR ENDWRR MOV 6(SS),AD CMP @SS,2(AD) ; SPACE ENOUGH IN CURRENT LINE ? BLE 1$ ; YES MOV AD,-(SS) ; NO. TAKE NEXT LINE ( CR-LF ) CALLSS PUTLN 1$: MOV (SS)+, -(HP) ;FIELDLENGTH MOV (HP), R0 SUB #14., R0 ;ANY LEADING BLANKS? MOV 4(SS),-(SS) ;FILE MOV #' ,-(SS) ;BLANKS CALLSS TRAILR WRR1: SUB #6, (HP) ;CALCULATE NUMBER OF DIGITS BGT WRR3 ;FIELDLENGTH MUST BE 7 AT LEAST MOV #1, (HP) ;MINIMUM NUMBER OF DIGITS WRR3: CMP (HP), #8. ;MAXIMUM BLE WRR4 MOV #8., (HP) ;TAKE MAXIMUM WRR4: MOV 2(SS), R0 ;LOW WORD FOR SIGN CALLSS PRTSGN BIC #100000,2(SS) ;REMOVE SIGN MOV #'.,-(SS) ;PRINT '.' WRRL3: CALLSS WRC TST (SS)+ ;REMOVE FILE MOVB (HP),1(HP) ;FIELD LEN TO NORMLZ MOV (HP)+,R1 CALLSS NORMLZ ;NORMALIZE MOV R2,-(HP) ; DEC EXP MOV R0,-(HP) ; EXP SIGN FLAG BIC #177400,R1 ; CLEAR HIGH BYTE ; V4-14 CALLSS DECDIG CMP (SS)+,(SS)+ ;REMOVE REAL FROM STACK MOV #'E,-(SS) CALLSS WRC ;WRITE E MOV #'+,-(SS) ; V5-10 MOV (HP)+,R0 ;EXP SIGN FLAG BGE WRRL4 ; V5-10 MOV #'-,(SS) ; V5-10 WRRL4: CALLSS WRC ; V5-10 MOV #60,-(SS) ;LOAD '0' MOV (HP)+,R2 ;EXPONENT WRR6: CMP R2, #10. ;GREATER THAN 10? BLT WRR5 SUB #10., R2 INC (SS) ;DECADES BR WRR6 WRR5: MOV R2,-(HP) ;SAVE DECIMAL EXP CALLSS WRC MOV (HP)+,-(SS) ;RETRIEVE DEC EXP ADD #60, (SS) CALLSS WRC ;WRITE EXPONENT IN TWO DECIMALS ENDWRR: RTS MP ;*********************************** NORMLZ ********************************** ;NORMALIZES A (POSITIVE) REAL ON TOP BETWEEN 0.1 AND 1 ;REGISTER USE: R0, R1, R2 R1 UNMODIFIED, R2 CONTAINS (SIGNED) DECEXP ROUTINE NORMLZ ENDNLZ CLR -(HP) ;SET EXPONENT SIGN FLAG MOV R1,-(HP) ;STORE NUMBER OF DIGITS AFTER JSR MP, BINEXP ;GET BINARY EXPONENT BEQ NLZ0 ;EASY JOB BPL NLZ6 ;PLUS DEC 2(HP) ;SET SIGN FLAG NEG R2 ;POSITIVE EXPONENT NLZ6: MOV R2,-(SS) CALLSS FLT ;FLOAT BINEXP MOV #20233,-(SS) MOV #37632,-(SS) ;LOAD LOG2 ON THE STACK CALLSS MULR CALLSS TRC ;INTEGER RAW DECEXP MOV (SS)+, R2 ;LOAD INTO R2 NLZ0: MOV R2,-(HP) ;STORE DECEXP MOV 4(HP), R0 ;SIGN FLAG CALLSS SCALE TST R0 ;ADD SIGN TO STORED DECEXP BPL NLZ10 NEG (HP) ;SIGNED DECEXP NLZ10: JSR MP, BINEXP ;GET BINARY EXPONENT BEQ NLZ2 BPL NLZ1 ;EXP > 0 --> DIVIDE BY 10 CMP (SS), #37314 ;COMPARE NORMALIZED REAL TO 0.1 BGT NLZ2 ;GREATER --> NORMALIZED ALREADY BLT NLZ1 ;LESS --> MULTIPLY CMP 2(SS), #146314 ;SECOND PART BHIS NLZ2 ;GREATER OR EQUAL 0.1 NLZ1: CLR -(SS) MOV #41040,-(SS) ;LOAD FLOATING 10 TST R2 ;MULTIPLY OR DIVIDE? BGT NLZ3 DEC (HP) ;DECREMENT EXPONENT CALLSS MULR ;MULTIPLY BR NLZ2 ;READY NLZ3: INC (HP) ;INCREMENT EXPONENT CALLSS DIVR ;************************* CALL ROUND HERE? ********************* NLZ2: JSR MP, BINEXP ;GET BINARY EXPONENT TST @R5 BEQ 1$ ; FLOATING ZERO CLRB 1(R5) ;REMOVE EXPONENT BIS #200, (R5) ;HIDDEN BIT SWAB (R5) MOVB 3(R5),(R5) 1$: CLRB 3(R5) SWAB 2(R5) ;ARRANG REAL FOR OUTPUT MOVB 3(HP),R1 ;GET NUMBER OF ADD (HP),R1 ;WANTED DIGITS BIC #177400,R1 ;CLEAR LEFT CHAR ; V4-14 CMP R1,#9. BGT NLZ4 CLR R0 ; OVERFLOW SIGNAL ASL R1 ASL R1 ADD NLZRND-2(R1),2(SS) ADC (SS) ADC R0 ADD NLZRND-4(R1),(SS) ADC R0 BEQ NLZ4 TST R2 ; DEC CARRY IF ZERO ; V5-8 BEQ NLZ12 ; ; V5-8 INC R2 ; BINEXP ; V5-8 SEC ; SHIFT IN LOST BIT ; V5-8 BR NLZ11 ; ; V5-8 NLZ12: MOV #14631,(SS) ; V5-8 MOV #114700,2(SS) INC (HP) ;DECEXP NLZ4: INC R2 BGT NLZ5 ;NORMALIZE BINEXP ZERO CLC ; CLEAR CARRY NLZ11: ROR (R5) ROR 2(R5) ;SHIFT ONE PLACE BR NLZ4 NLZ5: MOV (HP)+, R2 ;RESTORE DECEXP BPL NLZ9 NEG R2 ;MAKE EXPONENT PLUS NLZ9: MOV (HP)+, R1 ;GET NUMBER OF DIGITS MOV (HP)+, R0 ;RESTORE DECEXP SIGN TST R2 ;CHECK IF EQUAL BNE NLZ7 ;IF DECEXP 0 THEN SIGN = + CLR R0 NLZ7: RTS MP ; NLZRND: .WORD 6314,146315 .WORD 507,127024 .WORD 40,142234 .WORD 3,43334 .WORD 0,51743 .WORD 0,4143 .WORD 0,327 .WORD 0,25 .WORD 0,2 BINEXP: MOV (R5), R2 ;EXPONENT PART BEQ ENDNLZ ROL R2 CLRB R2 SWAB R2 SUB #200, R2 ;BINARY EXPONENT - 1 ; V5-8 ENDNLZ: RTS MP ;********************************** DECDIG ****************************** ;DECDIG PRINTS DECIMAL DIGITS FROM A NORMALIZED REAL ;R1= NUMBER OF DIGITS ;R2 = DECEXP ; 4(SS) FILE ID ( LEFT ON STACK ) ; 2(SS) NORM. REAL ; (SS) "- ROUTINE DECDIG ENDDDG MOV R1, -(HP) ;SAVE NUMBER OF DIGITS TO BE PRINTED BLE DDG2 DDG1: CLR R0 ;INITIALIZE ASL 2(R5) ROL (R5) ;SHIFT ONE PLACE ROL R0 ;CATCH BITS FALLING OUT MOV R0,-(HP) MOV (R5),-(HP) MOV 2(R5),-(HP) ;STORE ASL 2(R5) ROL (R5) ROL R0 ;MULTIPLY BY TWO ASL 2(R5) ROL (R5) ROL R0 ;ANOTHER TIME ADD (HP)+,2(R5) ADC (R5) ADC R0 ADD (HP)+, (R5) ;ADD FOR MULTIPLY BY 10 ADC R0 ADD (HP)+, R0 ;COMPLETE DIGIT ADD #60, R0 ;CHARACTER CONVERSION MOV 4(SS),-(SS) ;FILE ID MOV R0, -(SS) CALLSS WRC TST (SS)+ ;REMOVE FILE ID DEC (HP) ;COUNT DIGITS BGT DDG1 DDG2: TST (HP)+ ;REMOVE COUNT ENDDDG: RTS MP ;******************************* PRTSGN ******************************* ;PRINTS A SIGN ON THE SIGN FLAG IN R0 ; (SS) FILE ID ( LEFT ON STACK ) ROUTINE PRTSGN ENDPSN MOV #' ,-(SS) ;LOAD SPACE ; V5-10 TST R0 ;DETERMINE SIGN BPL PSNL1 MOV #'-,(SS) ;MINUS PSNL1: CALLSS WRC ;WRITE SIGN ENDPSN: RTS MP ;****************************** TRAILR ******************************* ;PRINTS R0 CHARACTERS OF THE KIND GIVEN IN (SS) ; 2(SS) FILE ID ( LEFT ON STACK ) ROUTINE TRAILR ENDTRL MOV (SS)+,-(HP) ;SAVE CHARACTER MOV R0,-(HP) ;SAVE NUMBER OF CHAR'S TRL0: TST (HP) ;NUMBER OF CHARACTERS BLE TRL1 ;NO MORE MOV 2(HP),-(SS) ;LOAD CHARACTER CALLSS WRC DEC (HP) ;DECREMENT COUNTER BGT TRL0 TRL1: CMP (HP)+,(HP)+ ;REMOVE MODEL ENDTRL: RTS MP ;***************************** WRFIX ****************************** ;WRITES THE REAL IN 4(SS), 6(SS) IN A FIXED FORMAT ;FILE IN 8(SS) ;FIELDLENGTH IN 2(SS) ;NUMBER OF DIGITS AFTER DECIMAL POINT IN (SS) ROUTINE WRFIX ENDWRF MOV 8.(SS),AD CMP 2(SS),2(AD) ; SPACE ENOUGH IN CURRENT LINE ? BLE 1$ ; YES MOV AD,-(SS) ; NO. TAKE NEXT LINE ( CR-LF ) CALLSS PUTLN 1$: MOV (SS)+, R2 ;NUMBER OF DIGITS AFTER BMI WRF6 ;MUST BE > = 0 SUB R2, (SS) ;CALCULATE NUMBER OF DIGITS BEFORE SUB #2, (SS) ;FOR SIGN AND DEC. POINT BMI WRF6 ;MUST BE >= 0 MOVB R2,1(SS) ;PACK 'BEFORE' AND 'AFTER' MOV (SS)+, R1 ;AND MOVE TO R1 MOV 2(SS), -(HP) MOV (SS),-(HP) ;STORE REAL FOR FLOATING OUTPUT BIC #100000,(SS) ;REMOVE SIGN CALLSS NORMLZ ;NORMALIZE FOR EXPONENT MOV R1,-(HP) MOV R2,-(HP) TST R0 ;EXPONENT SIGN BPL WRF1 ;PLUS OR ZERO NEG (HP) ;SIGNED DECEXP MOV 4(SS),-(SS) ;FILE ID MOVB 2(HP), R0 ;NUMBER OF DIGITS BEFORE MOV #' ,-(SS) CALLSS TRAILR ;PRINT LEADING BLANKS MOV 4(HP), R0 ;RESTORE SIGN OF REAL CALLSS PRTSGN BR WRF2 WRF1: MOVB 2(HP), R0 ;CHECK IF FIELD LARGE ENOUGH SUB (HP), R0 ;R0 = NUMBER OF LEADING BLANKS BGE WRF3 CMP (HP)+,(HP)+ ;REMOVE TEMPS MOV (HP)+, (SS) MOV (HP)+, 2(SS) ;LOAD ORIGINAL REAL CLR -(SS) ;FOR FIELDLENGTH WRF6: MOV #15.,(SS) ;DEFAULT VALUE CALLSS WRR ;WRITE IN FLOATING FORMAT RTS MP WRF3: MOV 4(SS),-(SS) ;FILE MOV #' ,-(SS) CALLSS TRAILR ;PRINT BLANKS MOV 4(HP),R0 ;SIGN CALLSS PRTSGN TST (SS)+ ;REMOVE FILE ID MOV (HP), R1 ;INITIATE R1 FOR DECDIG CALLSS DECDIG ;PRINTS DIGITS BEFORE DEC. POINT MOV 4(SS),-(SS) ;FILE ID WRF2: MOV #'.,-(SS) CALLSS WRC ;PRINT DECIMAL POINT MOVB 3(HP),R1 ;INIT R1 FOR DECDIG TST (HP) ;IF (HP) < 0 THEN NO DIGITS PRINTED YET BPL WRF5 NEG (HP) ;MAKE (HP) > 0 CMPB (HP), 3(HP) BLE WRF4 MOVB 3(HP), (HP) ;IF 3(HP) > (HP) THEN ONLY ZEROES WRF4: MOV (HP), R0 ;FOR TRAILR MOV #'0,-(SS) ;ZEROES CALLSS TRAILR ; MOVB 3(HP),R1 SUB (HP), R1 ;NO OF DIGITS TO BE PRINTED WRF5: TST (SS)+ ;REMOVE FILE ID CALLSS DECDIG CMP (SS)+,(SS)+ ;REMOVE REALS ADD #8.,HP ;REMOVE TEMPS AND REALS ENDWRF: RTS MP .END ****