NAMES NAMES PASFQV.PAS P11ABSPAS.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 P11FIS.MAC P11FORFPP.MAC P11FORTR.MAC P11FPP.MAC P11FPPINI.MAC P11FREQV.MAC P11FSR.MAC P11GCML.MAC P11GEQ.MAC P11GEQM.MAC P11GEQM2.MAC P11GEQS1.MAC P11GEQS4.MAC P11GETPUT.MAC P11GRT.MAC P11GRTM.MAC P11GRTM2.MAC P11IASRNC.MAC P11INIT.MAC P11INITS.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 P11PBOOL.MAC P11RANDOM.MAC P11RDHLP.MAC P11RDI.MAC P11RDR.MAC P11REAL.MAC P11REDSET.MAC P11RESET.MAC P11REXP.MAC P11RLOG.MAC P11RSQRT.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 **** PASFQV.PAS (*$M-,T-,R-,Q-*) (* PASFQV.PAS *) (* MODIFIED 15-MAY-79 G.P. *) TYPE LINEELEMP = ^ LINEELEM; LINEELEM = RECORD MOV: INTEGER; ADDRES: 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 ADDRESS / NUMBER OF TIMES EXECUTED' ); WHILE LP <> NIL DO WITH LP^ DO BEGIN WRITELN ( F, ORD(LP):8:O, COUNT ); LP := PREVLINE; END; END; END (* PASFQV *). **** P11ABSPAS.MAC .TITLE ABSPAS .IDENT '790704' ; MODIFIED 4-JUL-79 G.P. ; .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 2$: QIO$S AR,AD,#5,,SS ;GP WTSE$S #5 ;GP MOVB @SS,AD MOV AD,IORESULT(R) CMP (SS)+,(SS)+ ; SKIP PARAMETERS RTS PC ; ; .END **** P11CMREAL.MAC .TITLE P11CMR REAL COMPARISON ROUTINES .IDENT '790817' ; MODIFIED 17-AUG-79 G.P. ;********************* EQUR ************************* ; ; ROUTINE EQUR ENDEQR EQRL0: LINK EQRL1-EQRL0 EQRL1: LINK NOLINK ;NO MORE CALLS CALLSS CMR BEQ CMTRUE BR CMFALSE ;******************************* NEQR ******************************* ROUTINE NEQR ENDNQR NQRL0: LINK NQRL1-NQRL0 NQRL1: LINK NOLINK CALLSS CMR BNE CMTRUE RTS MP ;****************************** LESR ******************************* ROUTINE LESR ENDLSR LSRL0: LINK LSRL1-LSRL0 LSRL1: LINK NOLINK CALLSS CMR BLT CMTRUE BR CMFALSE ;************************** LEQR ******************************* ROUTINE LEQR ENDLQR LQRL0: LINK LQRL1-LQRL0 LQRL1: LINK NOLINK CALLSS CMR BLE CMTRUE BR CMFALSE ;************************* GRTR ****************************** ROUTINE GRTR ENDGRR GRRL0: LINK GRRL1-GRRL0 GRRL1: LINK NOLINK CALLSS CMR BGT CMTRUE BR CMFALSE ;************************** GEQR ******************************* ROUTINE GEQR ENDGQR GQRL0: LINK GQRL1-GQRL0 GQRL1: LINK NOLINK 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: LINK NOLINK 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 /PAS501/ .PSECT PASRUN ; ; THIS IS THE RSX-11M RUNTIME SUPPORT PACKAGE FOR PASCAL. ; CALLED SUBROUTINES ARE ALWAYS INCLUDED IN THE TASK BY THE TASKBUILDER. ; ; SEVED TORSTENDAHL 1976-10-19 ; ; ; ; PASRUN, THE RUNTIME SUPPORT PACKAGE FOR PASCAL, WILL GET THE ; CONTROL WHEN A USER TASK IS STARTED. BEFORE TRANSFERRING CONTROL ; TO THE USER PART SOME INITIALIZING IS PERFORMED. ; - SS (=R5), THE SOFTWARE STACK POINTER, IS INITIALIZED TO GIVE ; 64 BYTES TO THE HARDWARE STACK, POINTED TO BY HP (=R6) ; - GP (=R3), THE POINTER TO THE DATA OF THE MAIN PROGRAM BLOCK ; AND THE HIDDEN GLOBAL DATA, IS SET ; - MP (=R4), THE POINTER TO THE DATA OF THE CURRENT BLOCK ; IS SET = GP ; - A SST VECTOR IS DECLARED. THIS IS TO MAKE IT POSSIBLE TO ; CLOSE ALL FILES AT ABORT. A POST MORTEM DUMP IN A FORM ; WITH VARIABLE NAMES AND OTHER DETAILES TO SIMPLIFY DEBUGGING ; CAN ALSO BE PRINTED IF REQUESTED AT COMPILE TIME. ; - CONTROL IS TRANSFERRED TO THE USER PROGRAM ; ; ; ; THE USER PROGRAM CAN REQUEST SERVICES FROM PASRUN ; THROUGH THE TRAP INSTRUCTION. THIS INSTRUCTION HAS A PARAMETER, ; WHOSE VALUE LIES IN THE RANGE 0..255. EACH VALUE CORRESPONDS TO A ; SERVICE ROUTINE. TRAPS ARE DEFINED FOR REAL ARITHMATIC, ; ARITHMETIC FUNCTIONS, FILE OPERATIONS ETCETERA. ; ; ; ; .SBTTL LOCAL CONSTANTS ; LUN1=1 LUN2=2 LUN3=3 LUN4=4 LUN5=5 LUN6=6 TILUN=5 ; ; MAXFILES=5 ;MAX NUMBER OF FILES BUFLEN=132. ; MAX RECORD SIZE ; FF=14 LF=12 CR=15 HT=11 SPC=40 ; FALSE=0 TRUE=1 ; ; ; ; BIT DEFINITIONS FOR THE IOSPEC PARAMETER ; RANDOM =1 UPDATE =2 APPEND =4 TEMPORARY=10 INSERT =20 SHARED =40 SPOOL =100 BLKMODE =200 ; HIDDEN BITS TTY =20000 TEXT =40000 INPUT =100000 ; ; ; OFFSET DEFINITION FOR THE STACKS ; STACKBEG=2 HPSIZE =400 ; 256 BYTES FOR HARDWARE STACK ; LINEADDR=2 ; ADDRESS OF LINENUMBER SELECTOR=4 ; ADDRESS OF DYNAMIC OPTION SWITCH WORD ; V4-33 MARKADDR=6. ; ADDRESS OF MARKPOINTER DAPADDR =8. ; ADDRESS OF DYNAMIC AREA POINTER LUNTAB =10. ; LOGICAL UNIT TABLE ; ; ; ; 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 ; ; ; ; REGISTER DEFINITIONS ; AR =%0 ; GENERAL PURPOSE REGISTER R =%1 ; - '' - AD =%2 ; - '' - GP =%3 ; GLOBAL BLOCK BASE POINTER MP =%4 ; CURRENT BLOCK BASE POINTER SS =%5 ; SOFTWARE STACK HP =%6 ; HARDWARE STACK ; ; ; ; ; ; DEFINITION OF HIDDEN PART OF FILE DEKLARATION ; FILESIZECORR =104. TEXTBUFFSIZE =132. FDBSIZE =96. FDB =-104. EOLNSTATUS =-8. EOFSTATUS =-6 IORESULT =-4 FILTYP =-2 ; ; ; ; .SBTTL LOCAL MACROS ; ; ; ; MACRO FOR SUBROUTINE CALL ; .MACRO CALLSS RTR,ENDRTR JSR MP,$'RTR .ENDM ; ; ; MACRO FOR SUBROUTINE RETURN ; .MACRO RETURN RTS MP .ENDM ; ; ; MACRO FOR SOB INSTRUCTION ; .MACRO SOB R, L DEC R BNE L .ENDM ; ; ; ; DUMMY MACRO FOR OLD LINK COMPATIBILITY ; .MACRO LINK NEXT .ENDM ; ; ; MACRO FOR ROUTINE ENTRY ; .MACRO ROUTINE RTR,ENDRTR .SBTTL RTR $'RTR:: .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 ; ; ; ; ;NAMES OF THE RUNTIME ROUTINES AND THEIR FUNCTION ; ; ERRN = 0. ;DUMMY ROUTINE FOR ERROR DETECTION ;REAL COMPARISON ROUTINES ; EQUR = 1 ;EQUALITY TEST FOR REALS ; NEQR = 2 ;NOT EQUAL REAL ; LESR = 3 ;LESS THAN ; LEQR = 4 ;LESS OR EQUAL ; GRTR = 5 ;GREATER THAN ; GEQR = 6 ;GREATER OR EQUAL ; ;REAL COMPARISON ROUTINES FIRST SUBTRACT THE REALS AND ; ;THEN TEST THE VALUE OF THE RESULT ON TOP OF THE STACK ;REAL ARITHMETIC ; ADR = 7 ;ADDS TWO REALS ON TTHE STACK ; SBR = 8. ;SUBTRACTS THE REAL ON TOP FROM THE REAL NEXT TO TOP ; SQRR = 9. ;SQUARE THE REAL ON TOP OF THE STACK ; MPR = 10. ;MULTIPLY REALS ; DVR = 11. ;DIVIDE REALS ; FLO = 12. ;FLOAT THE REAL NEXT TO TOP ; FLT = 13. ;FLOAT THE REAL ON TOP ; TRC = 14. ;TRUNCATE THE REAL ON TOP OF THE STACK ; RND = 15. ;ROUND ;MULTIPLE VALUE COMPARISON ROUTINES ; GRTM = 17. ;GREATER THAN ; GRTM2 = 18. ; ; LESM = 19. ;LESS THAN ; LESM2 = 20. ; ; GEQM = 21. ;GREATER THAN OR EQUAL ; GEQM2 = 22. ; ; LEQM = 23. ;LESS THAN OR EQUAL ; LEQM2 = 24. ; ; EQUM = 25. ;EQUAL ; EQUM2 = 26. ; ; EQUS4 = 27. ;LARGE SET EQUALITY TEST (4 WORDS) ; NEQM = 28. ;NOT EQUAL ; NEQM2 = 29. ; ; NEQS4 = 30. ;LARGE SET INEQUALITY TEST ;SINGLE WORD COMPARISON ROUTINES ; EQU = 31. ;EQUAL INTEGER ; NEQ = 32. ;NOT EQUAL ; GRT = 33. ;GREATER ; GEQ = 34. ;GREATER OR EQUAL ; LES = 35. ;LESS THAN ; LEQ = 36. ;LESS OR EQUAL ;INTEGER ARITHMETIC ; DVI = 37. ;INTEGER DIVISION ; MODI = 38. ;INTEGER MODULO ; SQI = 39. ;SQUARE INTEGER ; MPI = 40. ;INTEGER MULTIPLICATION ;MULTIPLE MOVE ; MOVM = 41. ;MOVE A MULTIPLE VALUE: ADDRESSES ON THE STACK ; MOVM2 = 42. ;MOVE A MULTIPLE VALUE: ADDRESSES IN REGISTERS AR,AD ; MOVMR = 97. ;MOVE A MULTIPLE VALUE IN REVERSE DIRECTION ;SET MANIPULATION ROUTINES ; INN = 44. ;TESTS IF A SETELEMENT IS IN A SET ; SGSIN = 45. ;ADDS ONE SETELEMENT TO A SET (1 OR 4 WORD) ; INITS = 46. ;CREATES AN EMPTY FOUR WORD SET ON THE STACK ; UNI4 = 47. ;UNION OF TWO FOUR WORD SETS ON THE STACK ; INT4 = 48. ;FORMS THE INTERSECTION OF TWO FOUR WORD SETS ; DIF4 = 49. ;FORMS THE DIFFERENCE OF TWO FOUR WORD SETS ; EXPST = 50. ;EXPANDS THE 1-WORD SET ON TOP TO A 4-WORD SET ; EXPSN = 51. ;EXPANDS THE 1-WORD SET NEXT TO TOP ; REDST = 52. ;REDUCES THE 4-WORD SET ON TOP TO A 1-WORD SET ; REDSN = 53. ;REDUCES THE 4-WORD SET NEXT TO TOP IN THE STACK ; LEQS1 = 70. ;SETINCLUSION (1 WORD SET) ; LEQS4 = 71. ; ,, (4 WORD SET) ; GEQS1 = 72. ; ,, (1 WORD SET) ; GEQS4 = 73. ; ,, (4 WORD SET) ;MARK,RELEASE AND RUNTIME CHECK ROUTINES ; MARKP = 66. ;MARKS THE CURRENT VALUE OF DYNAMIC AREA POINTER ; RELEASEP = 67. ;RELEASES PART OF THE ALLOCATED HEAP ; OVFLCHK = 68. ;CHECK FOR FREE STORAGE SPACE ; SUBRCHK = 69. ;CHECK SUBRANGE OVERFLOW ;PACKED BOOLEAN ACCESS ROUTINES AND ADDITIONALS ; IXB = 54. ;INDEXING IN BOOLEAN ARRAYS ; STPB = 55. ;STORE A BOOLEAN IN A PACKED B ARRAY ; LPB = 56. ;LOAD A BOOLEAN FROM A PACKED BOOLEAN ARRAY ; CLRAREA = 57. ;CLEAR PART OF THE AREA (FOR PACKED STRUCTURE) ; CLRSTK = 58. ;CLEAR LOCAL AREA OF PROCEDURE BLOCK ;ROUTINES FOR FILE HANDLING ; EOFF = 77. ;END OF FILE ; RESETF = 78. ;RESET A FILE FOR READING ; REWRITEF = 79. ;REWRITE A FILE FOR WRITING ;READ AND WRITE ; RDC = 59. ;READ A CHARACTER FROM THE FILE INPUT ; RDI = 60. ;READ AN INTEGER FROM THE FILE INPUT ; RDR = 61. ;READ A REAL FROM THE FILE INPUT ; WRCHA = 43. ;WRITE CHARACTER IN A FIELD OF SPECIFIED LENGTH ; WRC = 62. ;WRITE A SINGLE CHARACTER ON A LINE OF 78 CHARS MAX. ; WRS = 63. ;WRITE A STRING IN A FIELD OF SPECIFIED LENGTH ; WRI = 64. ;WRITE AN INTEGER ,, ,, ,, ; WRR = 65. ;WRITE A REAL ,, ,, ; WRFIX = 92. ;WRITE A REAL IN FIXED FORMAT ; GETCH = 74. ;GET NEXT CHARACTER OF INPUTFILE ; GETLINE = 75. ;SKIPS THE INPUTSTRING UNTIL 'EOL' HAS BEEN READ ; GETBUFFER = 76. ;GETS NEW BUFFER FROM KEYBOARD(ONE LINE, 60 CHARS MAX) ; PUTCH = 80. ;APPENDS THE OUTPUT BUFFER VARIABLE TO THE OUTPUT FILE ; PUTLINE = 81. ;APPENDS THE CONTROL CHAR'S TO THE OUTPUTFILE ;ADDITIONAL ROUTINES ; EXITP = 16. ;TERMINATES A PROGRAM ; CMR = 82. ;COMPARE REALS ; EXPTOP = 83. ;EXPONENT ON TOP ; EXPNTOP = 84. ;EXPONENT NEXT TO TOP ; SIGNS = 85. ;SIGNS OF REALS ; NORM = 86. ;FOR NORMALIZATION ; SCALE = 87. ;SCALING ; RDSIGN = 88. ;READS SIGN OF NUMERICAL INPUT ; WRERROR = 89. ;WRITES ERROR MESSAGES ; DIGIT = 90. ;CHECKS CHARACTER AND CONVERTS TO DIGIT ; UNSINT = 91. ;READS AN UNSIGNED INTEGER ; NORMLZ = 93. ;REAL NORMALIZATION ; DECDIG = 94. ;PRINTS DECIMAL DIGITS OF A REAL ; PRTSGN = 95. ;PRINTS THE SIGN OF A REAL ; TRAILR = 96. ;PRINTS A NUMBER OF (EQUAL) CHARACTERS ; TWPOW = 98. ;POWERS OF TWO ; SPLTRL = 99. ;SPLITS A REAL INTO EXPONENT AND MANTISSA ;ARITHMETIC FUNCTIONS OF TYPE REAL ; RSIN = 100. ;SINUS ; RCOS = 101. ;COSINE ; RARCTAN = 102. ;ARCTANGENT ; REXP = 103. ;EXPONENT ; RLOG = 104. ;NATURAL LOGARITHM ; RSQRT = 105. ;SQUARE ROOT ; SUBSTRCHECK = 106. ;CHECKS BOUNDS OF SUBSTRING ; STRINGINDEX = 107. ;CHECKS INDEX IN STRINGPARAMETER ; DUMRTR = 108. ;DUMMY END ROUTINE ; ; .LIST **** P11DFAULT.MAC .TITLE P11DFAULT .IDENT '790716' ; MODIFIED 16-JUL-79 G.P. ; ; 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 LINK NOLINK 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 .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) BR D ; ; ROUTINE DUMP CLR -(HP) D: SNAP$ ,,,#$$HEAP-2,DAPADDR(GP),SS,-2(GP) CALLSS EXITP ; $P.VEC::.WORD D1,D2,D3,D4,D5,D6,D7,D8 ; .END **** P11DVI.MAC .TITLE DIVI ; ;***************************************** ;********** ********** ;********** NO EXTRA HARDWARE ********** ;********** ********** ;***************************************** ; ;****************************** DIVI ******************************** ROUTINE DIVI ENDDIVI DVIL0: LINK NOLINK 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 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 ;NOT 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 ****************************** ROUTINE MODI ENDMOD MODL0: LINK MODL1-MODL0 MODL1: LINK NOLINK CALLSS DIVI MOV R,(SS) ;LOAD THE REMAINDER ENDMOD: RTS MP .END **** P11EISDVI.MAC .TITLE DIVI ; CORRECTION V4-20 1977-06-07 OEN ; ;********************************************** ;********** ********** ;********** E I S ********** ;********** ********** ;********** EXTENDED INSTRUCTION SET ********** ;********** ********** ;********************************************** ; ;****************************** DIVI ******************************** ROUTINE DIVI ENDDIVI MOV (SS)+,AD BNE DVI1 CALLSS WRERROR ; ATTEMPT TO DIVIDE BY ZERO .BYTE 20.,1 CLR (SS) ; RETURN ZERO CLR R ; AND ZERO REMAINDER BR ENDDVI DVI1: MOV (SS)+,R SXT AR ;EIS ON MODEL 35 AND UP DIV AD,AR MOV AR,-(SS) ; QUOTIENT ENDDVI: RTS MP ;***************************** MODI ****************************** ROUTINE MODI ENDMOD CALLSS DIVI MOV R,(SS) ;LOAD THE REMAINDER ENDMOD: RTS MP .END **** P11EISMPI.MAC .TITLE MULI ; ;********************************************** ;********** ********** ;********** 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 LINK NOLINK 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 ;*************************** EQUM *************************** ROUTINE EQUM ENDEQM EQML0: LINK EQML1-EQML0 ;LINK FOR CALL OF EQUM2 MOV (SS)+,AR ;SOURCE ADDRESS IN AR MOV (SS)+,AD ;DESTINATION ADDRESS IN AD MOV (MP)+, R ;LENGTH (IN WORDS) IN R ; V4-6 EQML1: LINK NOLINK CALLSS EQUM2 ENDEQM: RTS MP .END **** P11EQUM2.MAC .TITLE EQUM2 ;**************************** EQUM2 ************************** ROUTINE EQUM2 ENDEQ2 LINK NOLINK 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 .END **** P11EQUS4.MAC .TITLE EQUS4 ;****************************** EQUS4 **************************** ROUTINE EQUS4 ENDQS4 QS4L0: LINK QS4L1-QS4L0 ;LINK FOR CALL OF EQUM2 MOV SS, AR ;SOURCE ADDRESS IN AR MOV SS, AD ADD #8., AD ;DESTINATION ADDRESS IN AD MOV #4, R ;LENGTH IN R QS4L1: LINK NOLINK CALLSS EQUM2 ; MOV (SS), 16.(SS) ;LOAD BOOLEAN RESULT ADD #16., SS ;REMOVE SETS ENDQS4: RTS MP .END **** P11EXIT.MAC .TITLE P11EXIT ; CORRECTION V4-44 1977-09-07 STD ; CORRECTION V4-53 1977-10-13 STD ; CORRECTION V4-54 1977-10-13 STD .IDENT '790727' ; MODIFIED 27-JUL-79 G.P. ; .MCALL QIO$S,WTSE$S,EXIT$S,PRINT$,CLOSE$ .MCALL FDOF$L,DELET$ FDOF$L ; DEFINE FDB OFFSETS ; ; CLOSE(F) ; ; (SS) POINTER TO FILE POINTER ; $CLOSE: ; FINDFILE (SS)+ CLOSE1: MOV AD,-(SS) ; V4-53 BIT #TEXT,FILTYP(R) ; V4-53 BEQ 1$ ; V4-53 BIT #INPUT,FILTYP(R) ; V4-53 BNE 5$ ; V4-53 CMP 2(R),#132. ; ANY CHAR LEFT ; V4-53 BEQ 5$ ; NO ; V4-53 MOV R,-(SS) ; DOUBLE FILE ID; V4-53 CALLSS PUTLN ; V4-53 5$: BIT #TTY,FILTYP(R) ; V4-53 BNE 9$ ; V4-53 BIT #SPOOL,FILTYP(R) ; V4-53 BEQ 1$ PRINT$ R0 BR 2$ 1$: TST F.RSIZ(AR) ; TEST IF FILE IS EMPTY BNE 4$ ; IF EMPTY THEN DELETE ELSE CLOSE ; ; ( TEXTFILES ONLY ) DELET$ R0 BR 2$ 4$: BIT #TEMPORARY,FILTYP(R) BEQ 3$ CALL .MRKDL 3$: CLOSE$ R0 2$: MOV @SS,AD MOVB F.LUN(AR),R ASL R ADD GP,R CLRB F.LUN(AR) ; CLEAR LUN IN FDB CLR LUNTAB(R) ; AND LUNTABLE 9$: MOV (SS)+,AD ; RESTORE AD 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:: TST (SS)+ ; SKIP MP LINK ; V4-54 CALLSS CLOSE RTS PC ; ; ; EXITP ; ROUTINE EXITP ; MOV #<2*MAXFILES+2>,AD ADD GP,AD MOV #MAXFILES+1,-(HP) 1$: MOV LUNTAB(AD),-(SS) BEQ 3$ INC LUNTAB(AD) BEQ 3$ 2$: JSR MP,$CLOSE 3$: TST -(AD) DEC @HP BGT 1$ EXIT$S ; ; .END **** P11EXPSET.MAC .TITLE EXPSET ;***************************** EXPST ***************************** ROUTINE EXPST ENDEST LINK NOLINK 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 LINK NOLINK 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 **** P11FIS.MAC .TITLE P11RAR REAL ARITHMETIC SUBROUTINES ; CORRECTION V4-17 1977-06-23 STD ; ;********************************************** ;********** ********** ;********** 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 SCLL0: LINK SCLL1-SCLL0 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 SCLL1: LINK SCLL2-SCLL0 CALLSS MULR ;MULTIPLY BR SCL5 SCL4: SCLL2: LINK NOLINK 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 RNDL0: LINK RNDL1-RNDL0 CLR -(SS) MOV #40000, -(SS) ;LOAD REAL VALUE 0.5 RNDL1: LINK RNDL2-RNDL0 BIT #100000,4(SS) ; V4-13 BEQ RND1 ; V4-13 BIS #100000,(SS) ; SET CORRECT SIGN ; V4-13 RND1: CALLSS ADDR ;ADD ; V4-13 RNDL2: LINK NOLINK 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 TRCL0: LINK TRCL1-TRCL0 TRCL1: LINK NOLINK 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 SQRL0: LINK SQRL1-SQRL0 MOV 2(SS),-(SS) ;COPY THE REAL ON TOP OF THE STACK MOV 2(SS),-(SS) ; SQRL1: LINK NOLINK ;AND MULTIPLY 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 SGNL0: LINK SGNL1-SGNL0 TST R0 BEQ SGN0 ;BOTH 'PLUS' ASL R0 CMP R0, #1002 BEQ SGN0 ;BOTH 'MINUS' MOV #1, R0 SGN0: SGNL1: LINK NOLINK CALLSS NORM ;NORMALIZE REAL ENDSGN: RTS MP ;******************************** SUBR **************************** ROUTINE SUBR ENDSUBR FSUB R5 ENDSBR: RTS MP ;*************************** DIVR ***************************** ROUTINE DIVR ENDDIVR DVRL0: LINK DVRL2-DVRL0 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 LINK NOLINK CLR R0 ;CLEAR SIGNS MOV (R5), R1 ASL R1 ROR R0 ;SIGN OF SECOND REAL SWAB R0 ASL R0 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 LINK NOLINK 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 FLTL0: LINK FLTL1-FLTL0 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 FLTL1: LINK NOLINK CALLSS NORM ;NORMALIZE REAL ENDFLT: RTS MP ;******************************* FLO *************************** ROUTINE FLO ENDFLO FLOL0: LINK FLOL1-FLOL0 MOV (SS)+,-(HP) MOV (SS)+,-(HP) ;STORE REAL ON TOP FLOL1: LINK NOLINK 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 NRML0: LINK NOLINK 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) ; ; INTERFACE TO FORTRAN ROUTINES ; ; FOR USE ON PROCESSORS WITH FPP. ; 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) STFPS -(HP) ; SAVE FLOATING POINT STATUS MOV DAPADDR(GP),@#$OTSV ; FORTRAN OTS CONTEXT SAVE/PTR JSR PC,@AD ; CALL THE FORTRAN ROUTINE 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 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 SCLL0: LINK SCLL1-SCLL0 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 SCLL1: LINK SCLL2-SCLL0 CALLSS MULR ;MULTIPLY BR SCL5 SCL4: SCLL2: LINK NOLINK 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 RNDL0: LINK RNDL1-RNDL0 CLR -(SS) MOV #40000, -(SS) ;LOAD REAL VALUE 0.5 RNDL1: LINK RNDL2-RNDL0 BIT #100000,4(SS) ; V4-13 BEQ RND1 ; V4-13 BIS #100000,(SS) ; SET CORRECT SIGN ; V4-13 RND1: CALLSS ADDR ;ADD ; V4-13 RNDL2: LINK NOLINK 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 SQRL0: LINK SQRL1-SQRL0 MOV 2(SS),-(SS) ;COPY THE REAL ON TOP OF THE STACK MOV 2(SS),-(SS) ; SQRL1: LINK NOLINK ;AND MULTIPLY 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 SGNL0: LINK SGNL1-SGNL0 TST R0 BEQ SGN0 ;BOTH 'PLUS' ASL R0 CMP R0, #1002 BEQ SGN0 ;BOTH 'MINUS' MOV #1, R0 SGN0: SGNL1: LINK NOLINK 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 DVRL0: LINK DVRL2-DVRL0 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 LINK NOLINK CLR R0 ;CLEAR SIGNS MOV (R5), R1 ASL R1 ROR R0 ;SIGN OF SECOND REAL SWAB R0 ASL R0 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 LINK NOLINK 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 FLOL0: LINK FLOL1-FLOL0 MOV (SS)+,-(HP) MOV (SS)+,-(HP) ;STORE REAL ON TOP FLOL1: LINK NOLINK 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 NRML0: LINK NOLINK 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 P11INIT P11V5 ; CORRECTION V4-34 ; CORRECTION V4-40 1977-08-16 OEN ; CORRECTION V4-50 ; CORRECTION V5-1 1978-05-15 OEN .IDENT '790517' ; MODIFIED 17-MAY-79 G.P. .MCALL FINIT$,SFPA$S,ASTX$S,GTSK$S ; ; ;>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ;>>>>> <<<<<< ;>>>>> SPECIAL VERSION FOR PROCESSORS WITH <<<<<< ;>>>>> FLOATING POINT PROCESSOR. <<<<<< ;>>>>> <<<<<< ;>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ; ; ROUTINE INITA FINIT$ SFPA$S #FLTAST ; SPECIFY FPP AST ROUTINE LDFPS #7400 ; ENABLE UNDERFLOW, OVERFLOW, ; CONVERSION AND "-0" ERROR INTERRUPT SETI ; SET FPP TO SHORT INTEGER SETF ; SET FPP TO SHORT FLOATING MOV #$$HEAP,SS ; V5-1 GTSK$S SS ; V5-1 MOV 32(SS),SS ; PARTITION SIZE ; V5-1 SUB #2,SS ; PONTER TO LAST WORD IN PARTITION ; V5-1 MOV SS,@HP ; - TO MP AT EXIT ; V5-1 FILAREA=FILESIZECORR+TEXTBUFFSIZE+4 MOV SS,AD ; CLEAR HEAP AND STACK MOV AD,AR SUB #$$HEAP,AR ASR AR ; NO OF WORDS TO CLEAR BIC #100000, AR ; TO CLEAR HEAP LARGER THAN 16K ; GP 1$: CLR -(AD) DEC AR BGT 1$ MOV MP,AD ; RESERV SPACE FOR STANDARD FILES TST (AD)+ BEQ 2$ SUB #FILAREA,SS ; INPUT 2$: TST (AD)+ BEQ 3$ SUB #FILAREA,SS ; OUTPUT 3$: TST (AD)+ FILAREA=FILAREA-FDBSIZE BEQ 4$ SUB #FILAREA,SS ; TTYIN 4$: TST (AD)+ BEQ 5$ SUB #FILAREA,SS ; TTYOUT 5$: MOV #MAXFILES+2,AR ; LUNTAB 6$: CLR -(SS) DEC AR BGT 6$ DEC @SS ; TTYIN NOT AVAILABLE DEC 2*TILUN(SS) ; TTYOUT NOT AVAILABLE MOV #$$HEAP,-(SS) ; DAPADDR := START ADDR OF STACK MOV @SS,-(SS) ; MARKADDR := START ADDR OF STACK MOV #$P.SEL,-(SS) ; OPTION SELECTOR WORD ; V4-34 CLR -(SS) ; LINE NUMBER WORD ; V4-34 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,R MOV (MP)+,-(SS) ; FILE POINTER BEQ NOFILE ADD GP,@SS MOV #-1,-(SS) ; FILE TYPE = TEXT MOV FNAM(R),-(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 JSR MP,@FSTOPN(R) BR NEXT ; NOFILE: TST (SS)+ ; REMOVE ZERO NEXT: CMP @HP,#6 BNE NEW ; MORE FILEPOINTERS LEFT TST (HP)+ ; REMOVE COUNTER MOV GP,@HP ; TO MP AT EXIT 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)+,R ; FILE POINTER CLR EOFSTATUS(R) ; FALSE MOV #1,IORESULT(R) ; OK MOV R,@R SUB #FILESICORR+TEXTBUFFSIZE-FDBSIZE,@R CLR 2(R) ; NO CHAR'S MOVB #40,@(R) ; TTYIN^ := ' ' ; V4-50 CMP 2(HP),#6 ; WHICH FILE BNE TTYOUT MOV R,LUNTAB(GP) ; TTYIN MOV #TRUE,EOLNSTATUS(R) MOV #TTY+TEXT+INPUT,FILTYP(R) RETURN ; TTYOUT: MOV R,LUNTAB+<2*TILUN>(GP) ; TTYOUT CLR EOLNSTATUS(R) MOV #TTY+TEXT,FILTYP(R) MOV #TEXTBUFFSIZE,2(R) RETURN ; ; ;************************************************ ; ; PROCEDURE SLCTDF( I: INTEGER ); ; SLCTDF:: TST (SS)+ ; SKIP LINK MOV (SS)+,SELECTOR(GP) RTS PC ; ; ; 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.701411E38 ;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 .BYTE 33.,1 ; FLT TO INTEGER ; ZERO RETURNED BY HARDWARE BR ASTEND OVERFL: CALLSS WRERROR .BYTE 30.,0 ; WARNING LDF MAXR,AC0 ; RETURN MAXREAL BR ASTEND UNDERFL: CALLSS WRERROR .BYTE 31.,0 ; WARNING MINUS0: CLRF AC0 ; RETURN ZERO ASTEND: TST (HP)+ ; REMOVE FEC ASTX$S ; RETURN FROM AST ; ; .END **** P11FREQV.MAC .TITLE $P.FRQ ; ; ROUTINE P.FRQ MOV LUNTAB+2.(R3),-(SS) ; OUTPUT FILE ID 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  **** P11FSR.MAC .TITLE P11FSR .SBTTL DATA DECLARATIONS ; .MCALL FSRSZ$ ; FSRSZ$ MAXFILES ; .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 LINK NOLINK 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 GQML0: LINK GQML1-GQML0 MOV (SS)+, AR ;LOAD SOURCE ADDRESS IN AR MOV (SS)+, AD ;LOAD DESTINATION ADDRESS IN AD MOV (MP)+, R ;FETCH LENGTH ARGUMENT GQML1: LINK NOLINK CALLSS GEQM2 ENDGQM: RTS MP .END **** P11GEQM2.MAC .TITLE GEQM2 ;************************* GEQM2 ***************************** ROUTINE GEQM2 ENDGQ2 LINK NOLINK 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 LINK NOLINK 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 LINK NOLINK 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 '791109' ; MODIFIED 9-NOV-79 G.P. ; .MCALL GET$,PUT$,QIO$S,WTSE$S,FDOF$L ; FDOF$L ; DEFINE FDB OFFSETS ; ; ; WRREC ; 2(SS) = FILE ; (SS) = RECORD ADDRESS ; ROUTINE WRREC ; MOV (SS)+,AD FINDFILE @SS MOV @R,R MOV F.URBD(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 MOV R,-(SS) ; LEAVE FILE ON STACK BR $PUT2 ; ; .SBTTL PUT ; ; PUT(F) ; ; (SS) = POINTER TO FILE WINDOW ; ROUTINE PUT FINDFILE (SS)+ $PUT2:: BIT #TEXT,FILTYP(R) BNE PUTCH1 PUT$ MOV F.NRBD+2(AR),@R ; NEXT RECORD BUFFER MOVB F.ERR(AR),AD ; ERROR BYTE MOV AD,IORESULT(R) ; NEG IF ERROR 9$: RETURN PUTCH1: INC @R DEC 2(R) BLE PUTLN2 MOV #1,IORESULT(R) RETURN ; ; .SBTTL PUTLINE ; ; PUTLINE(F) ; ; (SS) = POINTER TO FILE WINDOW ; ROUTINE PUTLN FINDFILE (SS)+ PUTLN2: BIT #TTY,FILTYP(R) BNE PUTTTY MOV #TEXTBUFFSIZE,AD SUB 2(R),AD ; REMAINING CHAR IN LINE COUNTER 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 ; ; (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 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 ; ; ; .SBTTL WRCHA ; ; WRCHA(F,CHAR:N) ; ; 4(SS) = POINTER TO FILE WINDOW ; 2(SS) = CHARACTER ; (SS) = FIELDLENGTH ; ROUTINE WRCHA CLR AD MOV #1,-(SS) ; STRINGLENGTH BR WRS1 ; ; .SBTTL WRC ; ; WRC(F,CHAR) ; ; 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 ; ; ; ; PAGE(F) ; ; (SS) = FILE POINTER ; ROUTINE PAGE MOV @SS,-(SS) ; SAVE FILE POINTER CALLSS PUTLN MOV #FF,-(SS) ; FORM FEED CALLSS WRC CALLSS PUTLN RETURN ; ; ; ; WRS(F,STRING) ; ; 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 <= FIELDLEN MOV 2(SS),(SS) ; FIELDLEN := MIN(FL,STRL) 6$: MOV (SS)+,-(HP) ; SAVE STRINGLENGTH 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 ; STRINGLENGTH 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) ; ; 2(SS) = POINTER TO FILE WINDOW ; (SS) = ADDRESS OF CHARACTER ; ROUTINE RDC ; MOV @2(SS),AD ; POINTER IN BUFFER MOVB @AD,@(SS)+ MOV @SS,-(SS) ; LEAVE FILE POINTER ON STACK BR $GET ; CONSUMES ONE FILE POINTER ; ; ; RDREC ; ; 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 ; ; ; GET(F) ; ; (SS) = POINTER TO FILE WINDOW ; .ENABLE LSB ; ROUTINE GETLN ; MOV GP,AD ; <> ZERO BR GET3 ; ROUTINE GET ; CLR AD ; ZERO ; GET3: FINDFILE (SS)+,,LUNTAB(GP) ; IF TTY THEN ; V4-36 GET2: TST EOFSTATUS(R) BNE 99$ TST AD BNE 3$ ; IF GETLINE TST EOLNSTATUS(R) BNE 3$ ; IF EOLN THEN GETLN 2$: BIT #TEXT,FILTYP(R) BNE 7$ ; IF TEXTFILE $GET1:: 3$: CLR EOLNSTATUS(R) BIT #TTY,FILTYP(R) BNE GETTTY GET$ MOVB F.ERR(AR),AD MOV AD,IORESULT(R) ;***** MOV(B) LEAVES CARRY-BIT UNCHANGED BCC 1$ ; IF TRANSFER OK INC EOFSTATUS(R) INC EOLNSTATUS(R) ; V4-37 1$: MOV F.NRBD+2(AR),@R ; NEXT RECORD BUFFER BNE 5$ ; V4-15 MOV F.URBD+2(AR),@R ; USER RECORD BUFFER ; V4-15 5$: ; V4-15 BIT #TEXT,FILTYP(R) BEQ 9$ ; READY IF NOT TEXTFILE MOV F.NRBD(AR),2(R) ; REMAINING CHAR COUNTER BEQ 40$ ; SET EOLN IF EMPTY LINE 9$: RETURN ; 7$: DEC 2(R) BGT 8$ ; IF CHAR'S LEFT 40$: BIT #TTY,FILTYP(R) ; V4-36 BNE 48$ ; V4-36 45$: MOV F.URBD+2(AR),@R ; V4-36 48$: INC EOLNSTATUS(R) ; V4-36 MOVB #40,@(R) ; SPACE TST EOFSTATUS(R) ; V4-49 BEQ 49$ ; V4-49 MOVB #34,@(R) ; FS ; V4-49 49$: RETURN ; V4-49 8$: INC @R MOV #1,IORESULT(R) ; V4-27 RETURN ; 99$: CALLSS WRERROR .BYTE 66.,1 RETURN ; ; ; GETTTY: MOV R,AD MOV 2*TILUN+LUNTAB(GP),AR ; V4-36 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 TTYSB MOV AD,IORESULT(R) 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 CHAR'S BEQ 40$ ; MARK TI-IN ; V4-36 19$: RETURN ; ; ; TTPAR(F) ; ; (SS) = POINTER TO FILE WINDOW ; ; IF FILE IS TTYOUT THEN SWITCH TO TTYIN ; ROUTINE TTPAR MOV @SS,R ; FILE ID BIT #TTY,FILTYP(R) BEQ NOTTY ; IF NOT TTY MOV LUNTAB(GP),@SS ; TTYIN NOTTY: RETURN ; ; ; .DSABLE LSB ; ; RDSTR ; ; 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 ; CHARACTER IN THE LINE AND REPLACE THAT CHARACTER WITH A SPACE. ; ; IF THERE ARE NO REMAINING CHARACTERS IN THE LINE THEN FILL ; THE STRING WITH SPACES, LEAVE THE FILE POINTER WHERE IT WAS ; AND REPLACE THE CHARACTER POINTED TO BY THE FILE POINTER WITH ; A SPACE. (IT MAY HAVE BEEN A ZERO LENGTH LINE) ; ROUTINE RDSTR MOV (SS)+,AR ; LENGTH MOV (SS)+,AD ; ADDRESS MOV @SS,R ; FILE MOV 2(R), -(HP) ; AVAILABLE CHARACTERS IN LINE SUB AR,2(R) ; REMAINING CHAR'S IN LINE BGE 1$ ADD 2(R),AR 1$: MOV @R,-(SS) ; BUFFER POINTER ADD AR,@R ; UPDATE BUFFER POINTER MOV (SS)+,R ; OLD BUFFER POINTER 2$: DEC AR BLT 5$ ; NO CHAR'S IN BUFFER MOVB (R)+,(AD)+ ; READ CHAR'S BR 2$ 5$: MOV @SS,R ; FILE MOV 2(R),AR ; REMAINING CHAR'S BGE 4$ NEG AR ; NUMBER OF SPACES CLR 2(R) ; REMAINING CHAR'S MOV #TRUE,EOLNSTATUS(R) 3$: MOVB #' ,(AD)+ ; READ SPACES DEC AR BGT 3$ TST (HP) BEQ 6$ ; BR IF THERE WERE NO AVAIL CHARS DEC (R) ; BACKUP FILE POINTER TO LAST CHAR 6$: MOVB #' , @(R) 4$: TST (HP)+ RETURN ; ; ; .END **** P11GRT.MAC .TITLE GRT ;****************************** GRT *********************************** ROUTINE GRT ENDGRT LINK NOLINK 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 GRML0: LINK GRML1-GRML0 MOV (SS)+, AR ;LOAD SOURCE ADDRESS IN AR MOV (SS)+, AD ;LOAD DESTINATION ADDRESS IN AD MOV (MP)+, R ;FETCH LENGTH ARGUMENT GRML1: LINK NOLINK CALLSS GRTM2 ENDGRM: RTS MP .END **** P11GRTM2.MAC .TITLE GRTM2 ;************************* GRTM2 ************************** ROUTINE GRTM2 ENDGR2 LINK NOLINK 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 **** P11IASRNC.MAC .TITLE RUNCHK FOR IAS .IDENT '791007' ; MODIFIED 7-OCT-79 G.P. ; ;***************************************** ;********** ********** ;********** I A S ********** ;********** ********** ;***************************************** ; ;******************************** SUBSTRCHECK *********************** ROUTINE STRCH SUBSTRCHECK SBCL0: LINK NOLINK CMP 4(SS),6(SS) ;COMPARE UPPERBOUND AND LOWERBOUND BGE SCK3 ;CONTINUE IF UB >= LB CMP (SS)+,(SS)+ ;ERROR: REMOVE LMAX AND LMIN BR SCK2 ;ERROR MESSAGE SCK3: CMP (SS)+,2(SS) ;COMPARE LMAX TO ACTUAL UB BLT SCK1 ;UB > LMAX --> ERROR CMP (SS)+,2(SS) ;COMPARE LMIN TO ACTUAL LB BLE ENDSBC ;LMIN <= LB --> READY BR SCK2 SCK1: TST (SS)+ ;REMOVE LMIN SCK2: CALLSS WRERROR .BYTE 60.,1 ENDSBC: RTS MP ;******************************* STRINGINDEX ********** ROUTINE STIND STRINGINDEX STIL0: LINK NOLINK CMP 2(SS),(SS) ;COMPARE INDEX TO SIZE BLE STI1 ;ERROR TST (SS) ;TEST IF >= 0 BGE STI2 ;YES, READY STI1: CALLSS WRERROR .BYTE 61.,1 STI2: ENDSTI: RTS MP ;*************************** OVFLCHK ***************************** ROUTINE OVFLCHK ENDOFC OFCL0: LINK NOLINK MOV DAPADDR(GP), AR ;AR := DAP ADD #80., AR ;KEEP FREE STORE OF 40 WORDS CMP SS, AR ;SS > AR? BHI OFC0 ;YES, CONTINUE ; V4-10 CALLSS WRERROR .BYTE 10.,1 OFC0: ;CHECK FOR HARDWARE STACKOVFL CMP HP, #40. ; 20 WORDS BHI ENDOFC ; V4-10 CALLSS WRERROR .BYTE 11.,1 ENDOFC: RTS MP ;******************************* SUBRCHK ******************************* ROUTINE SUBRCHK ENDSCK SCKL0: LINK NOLINK CMP (SS), (MP)+ ;LOWER BOUND BLT SCKL2 CMP (SS), (MP)+ ;UPPER BOUND BLE SCK0 SCKL1: MOV @SS,-(SS) ; OFFENDING VALUE ; V4-26 MOV #1,-(SS) ; 1 PARAM ON STACK CALLSS WRERROR ; V4-26 .BYTE 12.,201 ; PARAMS ON STACK AND FATAL SCK0: RTS MP SCKL2: TST (MP)+ ;REMOVE SECOND ARGUMENT ENDSCK: BR SCKL1 .END **** P11INIT.MAC .TITLE P11INIT P11V5 ; CORRECTION V5-2 1978-07-12 STD .IDENT '791012' .SBTTL INITIALIZATION ; .MCALL FINIT$,GTSK$S ; ; ROUTINE INITA FINIT$ MOV #$$HEAP,SS GTSK$S SS MOV 32(SS),SS ; PARTITION SIZE SUB #2,SS ; POINTER TO LAST WORD IN PARTITION MOV SS,@HP ; - TO MP AT EXIT ; V5-2 FILAREA = FILESIZECORR + TEXTBUFFSIZE + 4 MOV SS,AD ; CLEAR HEAP AND STACK MOV AD,AR SUB #$$HEAP,AR ASR AR ; NO OF WORDS TO CLEAR BIC #100000, AR ; TO CLEAR HEAP LARGER THAN 16K ; G.P. 1$: CLR -(AD) SOB AR, 1$ ; G.P. MOV MP,AD ; RESERV SPACE FOR STANDARD FILES TST (AD)+ BEQ 2$ SUB #FILAREA,SS ; OUTPUT 2$: TST (AD)+ BEQ 3$ SUB #FILARE,SS ; INPUT 3$: TST (AD)+ FILAREA=FILAREA-FDBSIZE BEQ 4$ SUB #FILAREA,SS ; TTYOUT 4$: TST (AD)+ BEQ 5$ SUB #FILAREA,SS ; TTYIN 5$: MOV #MAXFILES+2,AR ; LUNTAB 6$: CLR -(SS) SOB AR, 6$ ; G.P. DEC @SS ; TTYIN NOT AVAILABLE DEC 2*TILUN(SS) ; TTYOUT NOT AVAILABLE MOV #$$HEAP,-(SS) ; DAPADDR := START ADDR OF STACK MOV @SS,-(SS) ; MARKADDR := START ADDR OF STACK MOV #$P.SEL,-(SS) ; OPTION SELECTOR WORD ; V4-35 CLR -(SS) ; LINE NUMBER WORD ; V4-35 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,R MOV (MP)+,-(SS) ; FILE POINTER BEQ NOFILE ADD GP,@SS MOV #-1,-(SS) ; FILE TYPE = TEXT MOV FNAM(R),-(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 JSR MP,@FSTOPN(R) BR NEXT ; NOFILE: TST (SS)+ ; REMOVE ZERO NEXT: CMP @HP,#6 BNE NEW ; MORE FILEPOINTERS LEFT TST (HP)+ ; REMOVE COUNTER ; MOV GP,@HP ; TO MP AT EXIT ; V5-2 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)+,R ; FILE POINTER CLR EOFSTATUS(R) ; FALSE MOV #1,IORESULT(R) ; OK MOV R,@R SUB #FILESICORR+TEXTBUFFSIZE-FDBSIZE,@R CLR 2(R) ; NO CHAR'S MOVB #40,@(R) ; TTYIN^ := ' ' ; V4-50 CMP 2(HP),#6 ; WHICH FILE BNE TTYOUT MOV R,LUNTAB(GP) ; TTYIN MOV #TRUE,EOLNSTATUS(R) MOV #TTY+TEXT+INPUT,FILTYP(R) RETURN ; TTYOUT: MOV R,LUNTAB+<2*TILUN>(GP) ; TTYOUT CLR EOLNSTATUS(R) MOV #TTY+TEXT,FILTYP(R) MOV #TEXTBUFFSIZE,2(R) ; A FULL LINE LEFT 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 LINK NOLINK 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 **** P11INN.MAC .TITLE INN .IDENT '790213' ; MODIFIED 13-FEB-79 G.P. ;**************************** 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 LINK NOLINK 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 BGT INN0 ; IF OUTSIDE RETURN FALSE MOV AR, R ; = SETELEMENT BIC #177770, AR ;AR BECOMES 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 LINK NOLINK 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 LINK NOLINK 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 LQML0: LINK LQML1-LQML0 ;LINK FOR CALL OF LEQM2 MOV (SS)+, AR ;SOURCE ADDRESS IN AR MOV (SS)+, AD ;DESTINATION ADDRESS IN AD MOV (MP)+, R ;LENGTH IN BYTES IN R LQML1: LINK NOLINK CALLSS LEQM2 ENDLQM: RTS MP .END **** P11LEQM2.MAC .TITLE LEQM2 ;*************************** LEQM2 *************************** ROUTINE LEQM2 ENDLQ2 LINK NOLINK ;NO CALLS FROM THIS ROUTINE 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 LINK NOLINK 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 LINK NOLINK 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 LINK NOLINK 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 LSML0: LINK LSML1-LSML0 MOV (SS)+, AR ;LOAD SOURCE ADDRESS IN AR MOV (SS)+, AD ;LOAD DESTINATION ADDRESS IN AD MOV (MP)+, R ;FETCH LENGTH ARGUMENT LSML1: LINK NOLINK CALLSS LESM2 ENDLSM: RTS MP .END **** P11LESM2.MAC .TITLE LESM2 ;**************************** LESM2 ************************** ROUTINE LESM2 ENDLS2 LINK NOLINK 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 ;******************************* MARKP ***************************** ROUTINE MARKP ENDMRK LINK NOLINK MOV MARKADDR(GP),@DAPADDR(GP) ;'HEAP' MARKPOINTER MOV DAPADDR(GP),MARKADDR(GP) ;MARKPOINTER := DAP ADD #2,DAPADDR(GP) ;DAP := DAP + 2 ENDMRK: RTS MP ;***************************** RELEASEP **************************** ROUTINE RELEASEP ENDRLS LINK NOLINK MOV MARKADDR(GP),DAPADDR(GP) ;DAP := MARKPOINTER MOV @DAPADDR(GP),MARKADDR(GP) ;GET MARKPOINTER FROM HEAP ENDRLS: RTS MP .END **** P11MOVM.MAC .TITLE MOVM ;********************************* MOVM ******************************* ROUTINE MOVM ENDMVM LINK NOLINK 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 LINK NOLINK 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 LINK NOLINK 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 SQIL0: LINK SQIL1-SQIL0 MOV (SS),-(SS) ;LOAD SECOND ARG FOR MULI SQIL1: LINK NOLINK CALLSS MULI ;MULTIPLY ENDSQI: RTS MP ;******************************* MULI ******************************** ROUTINE MULI ENDMULI MPIL0: LINK NOLINK 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 LINK NOLINK 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 ;***************************** NEQM ****************************** ROUTINE NEQM ENDNQM NQML0: LINK NQML1-NQML0 ;LINK FOR CALL OF NEQM2 MOV (SS)+, AR ;SOURCE ADDRESS IN AR MOV (SS)+, AD ;DESTINATION ADDRESS IN AD MOV (MP)+, R ;LENGTH ARGUMENT IN R NQML1: LINK NOLINK CALLSS NEQM2 ENDNQM: RTS MP .END **** P11NEQM2.MAC .TITLE NEQM2 ;******************************** NEQM2 ***************************** ROUTINE NEQM2 ENDQM2 LINK NOLINK 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 .END **** P11NEQS4.MAC .TITLE NEQS4 ;******************************** NEQS4 ******************************** ROUTINE NEQS4 ENDNQ4 NQ4L0: LINK NQ4L1-NQ4L0 ;LINK FOR CALL OF NEQM MOV SS, AR ;SOURCE ADDRESS IN AR MOV SS, AD ADD #8., AD ;DESTINATION ADDRESS IN AD MOV #4, R ;LENGTH IN R NQ4L1: LINK NOLINK CALLSS NEQM2 MOV (SS), 16.(SS) ;LOAD BOOLEAN RESULT ADD #16., SS ;REMOVE SETS ENDNQ4: RTS MP .END **** P11PBOOL.MAC .TITLE PBOOL .IDENT '790207' ; MODIFIED 7-FEB-79 G.P. ;********************************** IXB ******************************* ROUTINE IXB ENDIXB LINK NOLINK 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 STBL0: LINK STBL1-STBL0 ;LINK FOR CALL OF IXB MOV (SS)+,-(HP) ;STORE BOOLEAN STBL1: LINK NOLINK 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 LPBL0: LINK LPBL1-LPBL0 LPBL1: LINK NOLINK 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 LINK NOLINK MOV DAPADDR(GP), AD ;AD = DYNAMIC AREA POINTER (FORMER NP) MOV (MP)+, R ;R = LENGTH OF AREA TO BE CLEARED BEQ ENDCLA ;BR IF NOTHING TO CLEAR CLA0: CLR (AD)+ ;CLEAR WORD SOB R, CLA0 ;LOOP ENDCLA: RTS MP ;****************************** CLRSTK ******************************** ROUTINE CLRSTK ENDCLS LINK NOLINK MOV (MP)+, R ;R = LENGTH ARGUMENT BEQ ENDCLS ;BR IF NOTHING TO CLEAR CLS0: CLR -(SS) ;CLEAR STACKSPACE SOB R, CLS0 ;LOOP ENDCLS: RTS MP .END **** P11RANDOM.MAC .TITLE P11RANDOM ; .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,AD,,SS,,<@R,F.URBD(AR),,#0,6(SS)> WTSE$S AD MOVB @SS,AD MOV AD,IORESULT(R) ADD #10.,SS ; REMOVE ALL PARAMETERS RETURN ; ; .END **** P11RDHLP.MAC .TITLE RDHLP .IDENT '790608' ; MODIFIED 8-JUN-79 G.P. ;************************** 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 ;GP CMP R0, #11 ;TAB? ;GP BNE SKP1 ;NO SKP3: TST EOFSTATUS(R) 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 LINK NOLINK 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 ) DECCNT = %1 ROUTINE UNSINT ENDUSI USIL0: LINK USIL1-USIL0 CLR DECCNT ;COUNTS DECIMALS USIL1: LINK USIL2-USIL0 CALLSS DIGIT BVC USI2 ;V-BIT CLEAR --> DIGIT READ CLV ;CLEAR V BIT: NO DIGIT READ RTS MP ;VALUE 0, V-BIT CLEAR USIL2: LINK NOLINK CALLSS DIGIT ;TEST NEXT CHARACTER BVS USI4 ;NO DIGIT --> LEAVE USI2: ASL 2(R5) ;MULTIPLY LONG BY TEN ROL (R5) BCS MLT0 ;OVERFLOW MOV (R5),-(HP) MOV 2(R5),-(HP) ASL 2(R5) ROL (R5) BCS MLT2 ;OVERFLOW ; V4-28 ASL 2(R5) ROL (R5) BCS MLT2 ;OVERFLOW ; V4-28 ADD (HP)+, 2(R5) ADC (R5) BVS MLT1 ;ARITHMETIC OVERFLOW ; V4-28 ADD (HP)+,(R5) BVS MLT0 ;ARITHMETIC OVERFLOW ADD R0, 2(R5) ;LAST DIGIT READ ADC (R5) BVS MLT0 ;OVERFLOW: NUMBER MUST BE POSITIVE INC DECCNT ;INCREMENT EXPONENT MOV DECCNT,-(HP) MOV 4(SS),-(SS) ;FILE ID CALLSS GET ; NEXT CHARACTER MOVB @(R), R0 ;IN R0 MOV (HP)+,DECCNT BR USIL2 MLT2: TST (HP)+ ;SKIP TEMP ; V4-28 MLT1: TST (HP)+ ;SKIP TEMP ; V4-28 MLT0: MOV DECCNT,-(HP) ; SAVE DECCNT ; V4-28 MOV 4(SS),R ; FILE ID ; V4-28 MOV #-103.,IORESULT(R) ; OVERFLOW ERROR ; V4-28 CALLSS WRERROR ; V5-0 .BYTE 42.,4 ; V5-0 MOV (HP)+,DECCNT ; UNSAVE DECCNT ; V4-28 USI4: ENDUSI: RTS MP ;THE LONG INTEGER IS NOW IN (R5), 2(R5), ;V-BIT SET MEANS: DIGITS READ .END **** P11RDI.MAC .TITLE RDI ; CORRECTION V4-29 1977-08-12 ; CORRECTION V4-52 1977-10-12 STD .IDENT /771012/ ;*************************** RDI ******************************* ;READS AN INTEGER AND STORES IT AT THE ADDRESS IN (SS) ;2(SS) FILE ( LEFT ON STACK ) ROUTINE RDI ENDRDI RDIL0: LINK RDIL1-RDIL0 MOV (SS)+,-(HP) ;SAVE RESULT ADDRESS RDIL1: LINK RDIL2-RDIL0 CALLSS RDSIGN MOV R1,-(HP) ;STORE SIGN CLR -(SS) CLR -(SS) ;INITIATE LONG INTEGER ON STACK RDIL2: LINK NOLINK 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 .BYTE 40.,4 ; 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 .BYTE 41.,4 ; V5-0 RDI1: TST (SS) ;TEST LOW WORD BMI RDIL4 ;NUMBER TOO LARGE TST (HP)+ ;SIGN FLAG BEQ RDI3 NEG (SS) ;NEGATE INTEGER 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 .IDENT /770812/ ;**************************** 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 RDRL0: LINK RDRL1-RDRL0 MOV (SS)+,-(HP) ;ADDRESS OF RESULT RDRL1: LINK RDRL2-RDRL0 CALLSS RDSIGN ;READ SIGN MOV R1,-(HP) ;STORE SIGN FLAG CLR -(HP) ;INITIATE DECEXP ON STACK CLR -(SS) CLR -(SS) ;CREATE ROOM FOR LONG INTEGER RDRL2: LINK RDRL4-RDRL0 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 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: 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 RDRL4: LINK RDRL6-RDRL0 CALLSS UNSINT ;ADD FRACTION PART TO LONG INT SUB DECCNT,(HP) ;UPDATE DECIMAL EXPONENT 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 RDRL6: LINK RDRL7-RDRL0 CALLSS RDI ;READ EXPONENT AND LEAVE IN IN (SS) TST (SS)+ ;REMOVE FILE ID ADD (SS)+, (HP) ;UPDATE DECIMAL EXPONENT LDCLF: ;CONVERT A LONG INTEGER TO FLOATING REAL RDR4: 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 RDRL7: LINK RDRL8-RDRL0 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: RDRL8: LINK NOLINK 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 REAL ARITHMETIC SUBROUTINES ; ;***************************************** ;********** ********** ;********** 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 SCLL0: LINK SCLL1-SCLL0 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 SCLL1: LINK SCLL2-SCLL0 CALLSS MULR ;MULTIPLY BR SCL5 SCL4: SCLL2: LINK NOLINK 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 RNDL0: LINK RNDL1-RNDL0 CLR -(SS) MOV #40000, -(SS) ;LOAD REAL VALUE 0.5 RNDL1: LINK RNDL2-RNDL0 BIT #100000,4(SS) ; V4-13 BEQ RND1 ; V4-13 BIS #100000,(SS) ; SET CORRECT SIGN ; V4-13 RND1: CALLSS ADDR ;ADD ; V4-13 RNDL2: LINK NOLINK 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 TRCL0: LINK TRCL1-TRCL0 TRCL1: LINK NOLINK 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 SQRL0: LINK SQRL1-SQRL0 MOV 2(SS),-(SS) ;COPY THE REAL ON TOP OF THE STACK MOV 2(SS),-(SS) ; SQRL1: LINK NOLINK ;AND MULTIPLY 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 TST @R5 ; FIRST OPERAND = ZERO ? BNE 1$ ; NO ADD #4,R5 ; YES, JUST SKIP IT BR ENDADR 1$: TST 4(R5) ; SECOND OPERAND = ZERO BNE 2$ ; NO MOV (R5)+,2(R5) ; RESULT = FIRST OPERAND MOV (R5)+,2(R5) BR ENDADR 2$: CALLSS EXPTOP CALLSS EXPNTOP ;GET EXPONENTS AND SIGNS ;IN R2,R3 AND R0 CMP R2,R1 ;EXPONENTS EQUAL? BGT ADR2 BLT ADR1 CMP 4(R5),(R5) ;COMPARE FRACTIONS BMI ADR1 BGT ADR2 CMP 6(R5),2(R5) ;SECOND PART OF FRACTIONS BHIS ADR2 ;WE HAVE TO INTERCHANGE ADR1: MOV (R5)+,-(HP) MOV (R5)+,-(HP) MOV 2(R5),-(R5) MOV 2(R5),-(R5) MOV (HP)+,6(R5) MOV (HP)+, 4(R5) ;INTERCHANGE REALS MOV R2,-(HP) MOV R1,R2 MOV (HP)+,R1 ;INTERCHANGE EXPONENTS SWAB R0 ;INTERCHANGE SIGN BYTES 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 ADR6 ;YES ADR3: ASR (R5) ROR 2(R5) ;DIVIDE BY 2^(E(U)-E(V)) ROR (HP) ;STORE CARRY BIT DEC R1 BNE ADR3 ;LOOP ADR4: TST R0 ;BOTH SIGNS 'PLUS'? BEQ ADR5 CMP R0, #401 ;OR BOTH SIGNS 'MINUS'? BEQ ADR5 NEG 2(R5) ;WE HAVE TO DO SOMETHING ADC (R5) NEG (R5) ADR5: ADD 2(R5),6(R5) ;ADD FRACTIONS ADC 4(R5) ;TAKE CARE OF CARRY ADD (R5),4(R5) ADR6: CMP (R5)+,(R5)+ MOV (HP)+, R1 ;RESTORE R1 ADRL3: LINK NOLINK CALLSS NORM ;NORMALIZE AND PACK IN (R5), 2(R5) ENDADR: RTS MP ;******************************* MULR ***************************** ROUTINE MULR ENDMPR MPRL0: LINK MPRL1-MPRL0 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: MPRL1: LINK MPRL2-MPRL0 CALLSS EXPTOP MPRL2: LINK MPRL3-MPRL0 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 MPRL3: LINK NOLINK CALLSS SIGNS ;GET RESULT SIGN IN R0 ENDMPR: RTS MP ;***************************** SIGNS ****************************** ;REGISTER USE: R0 ONLY ;R2, R0 ARE PASSED TO NORM ROUTINE SIGNS ENDSGN SGNL0: LINK SGNL1-SGNL0 TST R0 BEQ SGN0 ;BOTH 'PLUS' ASL R0 CMP R0, #1002 BEQ SGN0 ;BOTH 'MINUS' MOV #1, R0 SGN0: SGNL1: LINK NOLINK CALLSS NORM ;NORMALIZE REAL ENDSGN: RTS MP ;******************************** SUBR **************************** ROUTINE SUBR ENDSUBR SBRL0: LINK SBRL1-SBRL0 ADD #100000,(SS) ;NEGATE REAL ON TOP SBRL1: LINK NOLINK CALLSS ADDR ;ADD REALS ENDSBR: RTS MP ;*************************** DIVR ***************************** ROUTINE DIVR ENDDIVR DVRL0: LINK DVRL2-DVRL0 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: DVRL2: LINK DVRL3-DVRL0 CALLSS EXPTOP DVRL3: LINK DVRL4-DVRL0 CALLSS EXPNTOP ;GET EXPONENTS IN R2,R1 MOV R0,-(HP) ;SAVE SIGNS SUB R1,R2 MOV 4(R5),R1 MOV 6(R5),R0 ;COPY NUMERATOR CLR 4(R5) CLR 6(R5) ;INITIATE RESULT MOV #24.,-(HP) ;COUNT FOR SHIFTS DVR3: CMP R1,(R5) ;POSSIBLE TO SUBTRACT? BLO DVR5 ;NO BHI DVR4 ;YES CMP R0,2(R5) ;CHECK LOW ORDER BLO DVR5 ;NOTHING TO DO DVR4: SUB 2(R5), R0 ;SUBTRACTION SBC R1 SUB (R5), R1 INC 6(R5) ;UPDATE QUOTIENT DVR5: ASL R0 ROL R1 ;MULTIPLE SHIFT ASL 6(R5) ;SHIFT QUOTIENT ROL 4(R5) DEC (HP) ;DECREMENT COUNT BGT DVR3 ;LOOP TST (HP)+ CMP (R5)+,(R5)+ ;REMOVE SECOND REAL MOV (HP)+, R0 ;RESTORE SIGN CLR R1 ;CLEAR CARRY REG. DVRL4: LINK NOLINK 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 LINK NOLINK CLR R0 ;CLEAR SIGNS MOV (R5), R1 ASL R1 ROR R0 ;SIGN OF SECOND REAL SWAB R0 ASL R0 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 LINK NOLINK 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 FLTL0: LINK FLTL1-FLTL0 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 FLTL1: LINK NOLINK CALLSS NORM ;NORMALIZE REAL ENDFLT: RTS MP ;******************************* FLO *************************** ROUTINE FLO ENDFLO FLOL0: LINK FLOL1-FLOL0 MOV (SS)+,-(HP) MOV (SS)+,-(HP) ;STORE REAL ON TOP FLOL1: LINK NOLINK 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 NRML0: LINK NOLINK 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 **** P11REDSET.MAC .TITLE REDSET ;******************************* REDST **************************** ROUTINE REDST ENDRST LINK NOLINK MOV (SS)+,(SS) ;MOVE FIRST SET WORD THREE PLACES UP MOV (SS)+,(SS) MOV (SS)+,(SS) ENDRST: RTS MP ;***************************** REDSN ******************************** ROUTINE REDSN ENDRSN LINK NOLINK 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 '791012' ; .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) = ADDR OF FNAM STRING ; 10(SS) = LEN OF FNAM STRING ; 8(SS) = ADDR OF FDIR STRING ; 6(SS) = LEN OF FDIR STRING ; 4(SS) = ADDR OF FDEV STRING ; 2(SS) = LEN OF FDEV STRING ; (SS) = IOSPEC ; ROUTINE RESET ; BIC #APPEND+UPDATE,@SS 1$: MOV #FO.RD,-(HP) BIS #INPUT,@SS BR RESET1 ; ; ROUTINE REWRITE ; MOV #FO.WRT,-(HP) BIC #INPUT,@SS RESET1: BIT #TTY,@SS BNE 6$ ; NO ACTION FOR TTY MOV 16.(SS),R 1$: MOV GP,AD CLR -(HP) 2$: CMP R,LUNTAB(AD) BEQ 5$ ; LUN FOUND TST (AD)+ INC @HP CMP @HP,#MAXFILES+1 BLE 2$ TST (HP)+ ; REMOVE COUNTER TST R BEQ 3$ ; NO FREE LUN AVAILABLE CLR R BR 1$ ; SEARCH FOR FREE LUN 3$: MOV 16.(SS),R ; FILE POINTER MOV #-101.,IORESULT(R) MOV #TRUE,EOFSTATUS(R) BR 4$ ; V4-51 6$: CLR EOFSTATUS(R) ; V4-51 4$: ADD #18.,SS TST (HP)+ ; REMOVE OPEN TYPE CODE ; V4-22 RETURN ; 5$: TST R BEQ NEWOPEN ; IF NOT OPEN ALREADY ; ; CLOSE FILE FIRST ; REOPEN: MOV R,AR SUB #FILESIZ,AR ; FDB ADDRESS BIT #TEMPORARY,FILTYP(R) BEQ 5$ ; NOT TEMP ; TEMP FILES: ; SAVE FILENAME BLOCK AND OPEN SAME FILE MOV AD,-(HP) ; SAVE LUN INDEX MOV AR,AD ADD #F.FNB,AD ; ADDRESS TO FILENAME PART OF FDB MOV #20,R 1$: MOV (AD)+,-(SS) DEC R BGT 1$ CLOSE$ MOV #20,R 2$: MOV (SS)+,-(AD) DEC R BGT 2$ MOV (HP)+,AD BIS #TEMPORARY,@SS ; SAME TEMP FILE BR NEWOPEN 5$: TST F.RSIZ(AR) ; TEST IF FILE IS EMPTY BNE 3$ ; IF EMPTY THEN DELETE ELSE CLOSE ; ; ( TEXTFILES ONLY ) TST IORESULT(R) BLT 4$ ; IF NONEXISTENT FILE DELET$ R0 BR 4$ 3$: CLOSE$ 4$: ; NEWOPEN:MOV 16.(SS),R ; FILE POINTER MOV R,LUNTAB(AD) ; RESERV LUN ; CLEAR THE FDB ; (IT MAY BE ALLOCATED OVER JUNK ON A PROCEDURE'S STACK) MOV R,AR ADD #FDB, AR ; FDB ADDRESS MOV #S.FDB/2, AD ; SIZE OF FDB IN WORDS 2$: CLR (AR)+ ; CLEAR FDB SOB AD, 2$ ; LOOP MOV R, AR ADD #FDB, AR ; FDB ADDRESS MOV (HP)+,AD 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 MOVB #FD.PLC,F.RACC(AR); LOCATE MODE ALUN$S AD,#$P.DEV,#$P.UNI; ASSIGN LUN TO DEFAULT (SY0:) MOV 14.(SS),F.RSIZ(AR); RECORD SIZE BGT 10$ ; 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 10$: MOVB #FD.CR,F.RATT(AR); CARRIAGE CONTROL NOT IN TEXT BIT #RANDOM,@SS BEQ 15$ ; 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 BIC #INSERT,@SS ; INSERT AND RANDOM NOT ALLOWED TOGETHER 15$: BIT #UPDATE,@SS BEQ 20$ ; IF UPDATE NOT SPECIFIED BIT #INSERT,@SS ; INSERT ? BEQ 17$ ; IF NO BISB #FD.INS,F.RACC(AR) 17$: MOV #FO.UPD,(HP) ; CHANGE FO.WRT TO FO.UPD BR 25$ ; NOT UPDATE 20$: BIT #APPEND,@SS BEQ 25$ ; IF NOT APPEND MOV #FO.APD,(HP) ; CHANGE FO.WRT TO FO.APD ; ALWAYS 25$: BIT #SHARED,@SS BEQ 30$ ; IF NOT SHARED BIS #FA.SHR,(HP) ; ALWAYS 30$: ; FD.INS => BIC #^C,@SS ; ????????? 31$: BIT #TEMPORARY,@SS BEQ 38$ BIS #FA.TMP,(HP) ; ALWAYS SKIP TRAILING BLANKS OF FILENAME, DIR AND DEV 38$: MOV SS,-(HP) ADD #12.,(HP) ; POINT TO FNAME ADDRESS 32$: MOV @(HP),AD ; ADDRESS OF FILENAME STRING SUB #2,(HP) TST AD ; STRING GIVEN ? BEQ 37$ ; NO ADD @(HP),AD ; LENGTH OF STRING 33$: CMPB -(AD),#40 BGT 34$ ; IF CHAR > SPACE DEC @(HP) ; ADJUST STRING LEN IF SPACE OR LESS BGT 33$ 34$: CMPB (AD)+,#': BNE 39$ DEC @(HP) 39$: MOV @(HP),-(HP) ; TEMP COUNTER FOR 50$: DEC @HP ; CONVERTING LOWER CASE BLT 60$ ; TO UPPER CASE CMPB -(AD),#137 BLE 50$ BICB #40,@AD BR 50$ 60$: TST (HP)+ ; REMOVE TEMP COUNTER 37$: SUB #2,(HP) CMP (HP),SS BGT 32$ ; FOR DIR AND DEV TST (HP)+ ; DELETE TEMP ; ALWAYS. DIR STRING IN [] MOV 8.(SS),AD ; ADDRESS OF DIR STRING TST 6(SS) ; LENGTH OF DIR STRING BEQ 36$ ; IF NOT GIVEN MOVB #'[,(AD) ADD 6(SS),AD DEC AD ; POINT TO LAST CHAR MOVB #'],(AD) 36$: MOV (HP)+,AD CLR EOFSTATUS(R) MOV (SS)+,FILTYP(R) ; MODIFIED IOSPEC INTO FILTYP ; FDB ADDR IN AR, FILE ACCESS IN AD & DATASET DESC ADDR IN SS OPEN$ ,AD,,SS MOVB F.ERR(AR),AD MOV AD,IORESULT(R) BGT 35$ INC EOFSTATUS(R) CLRB F.LUN(AR) ;RELEASE LUN ; V4-23 35$: ADD #16.,SS ; RELEASE ALL PARAMETERS BIT #INPUT+UPDATE,FILTYP(R) BEQ 40$ ; IF WRITE OR APPEND ; TST EOFSTATUS(R) ; OPEN OK ? BNE 9$ ; NO JMP $GET1 ; IF READ OR UPDATE ; 40$: BIS #TRUE,EOFSTATUS(R) ; TRUE CLR EOLNSTATUS(R) ; FALSE MOV F.NRBD+2(AR),@R BNE 45$ ; V4-16 MOV F.URBD+2(AR),@R ; V4-16 45$: ; V4-16 BIT #TEXT,FILTYP(R) BEQ 9$ ; IF NOT TEXTFILE MOV F.NRBD(AR),2(R) BNE 9$ MOV F.URBD(AR),2(R) ;;;;; MOV F.URBD+2(AR),@R ; V4-16 9$: 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 EXPL0: LINK EXPL1-EXPL0 MOV #125073,-(SS) MOV #040270,-(SS) ;LOAD LOG2(E) EXPL1: LINK EXPL2-EXPL0 CALLSS MULR ;X * LOG2(E) MOV 2(SS),-(SS) MOV 2(SS),-(SS) ;COPY X * LOG2(E) ON THE STACK EXPL2: LINK EXPL3-EXPL0 CALLSS TRC ;TRUNCATE: INT(X * LOG2(E)) ON STACK MOV (SS),-(HP) ;STORE INTEGER PART EXPL3: LINK EXPL4-EXPL0 CALLSS FLT ;FLOAT INTEGER FOR SUBTRACTION EXPL4: LINK EXPL5-EXPL0 CALLSS SUBR ;FRACTION(X * LOG2(E)) = ;X * LOG2(E) - INT(X * LOG2(E)) MOV #125073,-(SS) MOV #040470,-(SS) ;LOAD 2*LOG2(E) EXPL5: LINK EXPL6-EXPL0 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 EXPL6: LINK EXPL7-EXPL0 CALLSS SQRR ;Y * Y ON TOP OF STACK MOV #056133,-(SS) MOV #041560,-(SS) ;LOAD B1 = 60.0901907 EXPL7: LINK EXPL8-EXPL0 CALLSS ADDR ;B1 + Y * Y EXPL8: LINK EXPL9-EXPL0 CALLSS DIVR ;DIVIDE: A1/(B1 + Y * Y) MOV #036602,-(SS) MOV #141100,-(SS) ;LOAD A0 = -12.01501675 EXPL9: LINK EXPL10-EXPL0 CALLSS ADDR ;A0 + A1/(B1 + Y * Y) EXPL10: LINK EXPL11-EXPL0 CALLSS ADDR ;A0 + Y + A1/(B1 + Y * Y) EXPL11: LINK EXPL12-EXPL0 CALLSS DIVR ;Y/(A0 + Y + A1/(B1 + Y * Y)) CLR -(SS) MOV #140400,-(SS) ;LOAD -2.0 EXPL12: LINK EXPL13-EXPL0 CALLSS MULR ;-2.0 * Y/(. . . CLR -(SS) MOV #040200,-(SS) ;LOAD 1.0 EXPL13: LINK EXPL14-EXPL0 CALLSS ADDR ;1 - 2 * Y/( . . EXPL14: LINK NOLINK 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 LOGL0: LINK LOGL2-LOGL0 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 LOGL2: LINK LOGL3-LOGL0 CALLSS FLT ;FLOAT EXPONENT MOV -(MP),-(SS) MOV -(MP),-(SS) ;LOAD LN(2) LOGL3: LINK LOGL4-LOGL0 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) LOGL4: LINK LOGL5-LOGL0 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) LOGL5: LINK LOGL6-LOGL0 CALLSS ADDR ;X + 1/2 * SQRT(2) LOGL6: LINK LOGL7-LOGL0 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 LOGL7: LINK LOGL8-LOGL0 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: LINK LOGL9-LOGL0 CALLSS MULR ;R := R * Y MOV -(MP),-(SS) MOV -(MP),-(SS) ;LOAD C2 LOGL9: LINK LOGL10-LOGL0 CALLSS ADDR ;R := R + LOGTAB[I] DEC (HP) ;DECREMENT COUNTER BGT LOGL8 TST (HP)+ ;REMOVE COUNT LOGL10: LINK LOGL11-LOGL0 CALLSS MULR ;R := R * W MOV -(MP),-(SS) MOV -(MP),-(SS) ;LOAD -1/2 * LN(2) LOGL11: LINK LOGL12-LOGL0 CALLSS ADDR ;R := R - 1/2 * LN(2) MOV (HP)+,-(SS) MOV (HP)+,-(SS) ;LOAD EXP * LN(2) LOGL12: LINK NOLINK 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 SQTL0: LINK SQTL1-SQTL0 TST (SS) ;TEST IF EQUAL BEQ ENDSQT ;EASY JOB BGT SQ1 ;ARGUMENT MUST BE >= 0 SQTL1: LINK SQTL2-SQTL0 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 SQTL2: LINK SQTL3-SQTL0 CALLSS DIVR ;X/E SQTL3: LINK SQTL4-SQTL0 CALLSS ADDR ;X/E + E CLR -(SS) MOV #040400,-(SS) ;LOAD 2.0 SQTL4: LINK NOLINK 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 **** P11RUNCHK.MAC .TITLE RUNCHK .IDENT '790503' ; MODIFIED 3-MAY-79 G.P. ; CORRECTION V4-26 1977-08-08 STD ;******************************** SUBSTRCHECK *********************** ROUTINE STRCH SUBSTRCHECK SBCL0: LINK NOLINK CMP 4(SS),6(SS) ;COMPARE UPPERBOUND AND LOWERBOUND BGE SCK3 ;CONTINUE IF UB >= LB CMP (SS)+,(SS)+ ;ERROR: REMOVE LMAX AND LMIN BR SCK2 ;ERROR MESSAGE SCK3: CMP (SS)+,2(SS) ;COMPARE LMAX TO ACTUAL UB BLT SCK1 ;UB > LMAX --> ERROR CMP (SS)+,2(SS) ;COMPARE LMIN TO ACTUAL LB BLE ENDSBC ;LMIN <= LB --> READY BR SCK2 SCK1: TST (SS)+ ;REMOVE LMIN SCK2: CALLSS WRERROR .BYTE 60.,1 ENDSBC: RTS MP ;******************************* STRINGINDEX ********** ROUTINE STIND STRINGINDEX STIL0: LINK NOLINK CMP 2(SS),(SS) ;COMPARE INDEX TO SIZE BLE STI1 ;ERROR TST (SS) ;TEST IF >= 0 BGE STI2 ;YES, READY STI1: CALLSS WRERROR .BYTE 61.,1 STI2: ENDSTI: RTS MP ;*************************** OVFLCHK ***************************** ROUTINE OVFLCHK ENDOFC OFCL0: LINK NOLINK MOV DAPADDR(GP), AR ;AR := DAP ADD #80., AR ;KEEP FREE STORE OF 40 WORDS CMP SS, AR ;SS > AR? BHI OFC0 ;YES, CONTINUE ; V4-10 CALLSS WRERROR .BYTE 10.,1 OFC0: MOV STACKBEG, AR ;CHECK FOR HARDWARE STACKOVFL ADD #40., AR ; 20 WORDS CMP HP, AR BHI ENDOFC ; V4-10 CALLSS WRERROR .BYTE 11.,1 ENDOFC: RTS MP ;******************************* SUBRCHK ******************************* ROUTINE SUBRCHK ENDSCK SCKL0: LINK NOLINK CMP (SS), (MP)+ ;LOWER BOUND BLT SCKL2 CMP (SS), (MP)+ ;UPPER BOUND BLE SCK0 SCKL1: MOV @SS,-(SS) ; OFFENDING VALUE ; V4-26 MOV #1,-(SS) ; 1 PARAM ON STACK CALLSS WRERROR ; V4-26 .BYTE 12.,201 ; PARAMS ON STACK AND FATAL ; V4-26 SCK0: RTS MP SCKL2: TST (MP)+ ;REMOVE SECOND ARGUMENT ENDSCK: BR SCKL1 .END **** P11SGSIN.MAC .TITLE SGSIN ;****************************** SGSIN *************************** ROUTINE SGSIN ENDSGS LINK NOLINK 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 ;******************************** RSIN ****************************** ROUTINE RSIN ENDSIN SINL0: LINK SINL1-SINL0 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 SINL1: LINK SINL2-SINL0 CALLSS DIVR ;X/(PI/2) CLR -(SS) MOV #37600,-(SS) ;LOAD 0.25 SINL2: LINK SINL3-SINL0 CALLSS MULR ;0.25 * X/(PI/2) =X/2PI MOV 2(SS),-(SS) MOV 2(SS),-(SS) ;LOAD COPY OF X/2PI SINL3: LINK SINL4-SINL0 CALLSS TRC ;TRUNCATE FOR FRACTION SINL4: LINK SINL5-SINL0 CALLSS FLT ;FLOAT SINL5: LINK SINL6-SINL0 CALLSS SUBR ;FRACTION(X/2PI) TST (SS) ;ZERO? BEQ SIN6 ;YES, READY CLR -(SS) MOV #40600,-(SS) ;LOAD 4.0 SINL6: LINK SINL7-SINL0 CALLSS MULR ;4.0 * FRACTION MOV 2(SS),-(SS) MOV 2(SS),-(SS) ;COPY SINL7: LINK SINL8-SINL0 CALLSS TRC ;TRUNCATE: INT(4.0 * FRACTION) MOV (SS),-(HP) ;STORE SINL8: LINK SINL9-SINL0 CALLSS FLT ;FLOAT SINL9: LINK SINL10-SINL0 CALLSS SUBR ;FRACTION(4.0 * FRACTION(X/2PI)) ROR (HP) ;EVEN? BCC SIN2 ;YES ADD #100000,(SS) ;NO, NEGF CLR -(SS) MOV #040200,-(SS) ;LOAD 1.0 SINL10: LINK SINL11-SINL0 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 SINL11: LINK SINL12-SINL0 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 SINL12: LINK SINL13-SINL0 CALLSS MULR MOV -(MP),-(SS) MOV -(MP),-(SS) ;LOAD SINTAB[I] AND INITIATE RES SINL13: LINK SINL14-SINL0 CALLSS ADDR ;RES := RES * Z + SINTAB[I] DEC 4(HP) ;DECREMENT COUNT BGT SIN5 ;LOOP ADD #6, HP ;REMOVE COUNT AND Y * Y COPY SINL14: LINK NOLINK 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 COSL0: LINK COSL1-COSL0 MOV #007733,-(SS) MOV #040311,-(SS) ;LOAD PI/2 COSL1: LINK COSL2-COSL0 CALLSS ADDR ;X + 1/2PI COSL2: LINK NOLINK CALLSS RSIN ;SIN ENDCOS: RTS MP .END **** P11SPLTRL.MAC .TITLE SPLTRL ;******************************* SPLTRL ******************************* ROUTINE SPTRL ENDSPR LINK NOLINK 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 .IDENT '791011' ; ; .MCALL QIO$S,WTSE$S ; ROUTINE P.TRC MOV MP, R1 ; LINE ADDRESS MOV #20040,-(SS) SUB #6., SS ; SPACE FOR NUMBER STRING MOV SS, R0 MOV PC, R2 ; DONT SUPRESS LEADING ZEROS CALL $CBOMG ; CONV BIN TO OCTAL MAGN MOV SS,R0 ; ADDR OF STRING CLR R1 ; 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 ADD #8.,SS RETURN ; ; .END **** P11TWPOW.MAC .TITLE TWPOW ;******************************* TWPOW ****************************** ROUTINE TWPOW ENDTWP LINK NOLINK 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 LINK NOLINK 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 '790515' ; MODIFIED 15-MAY-79 G.P. ; .MCALL QIOW$S ; ; ; WRERROR ; ; MP = ADDRESS OF ERROR BYTES ; ; BYTE 1 : ERROR NUMBER ; BYTE 2 : ERROR TYPE ; 0 WARNING ; 1 FATAL ERROR ; 2 WARNING ; 4 MESSAGE ; +128. IF PARAMETERS ON SS ; ; ; IF ERROR BYTE 2 > 127. THEN SS DELIVERS PARAMETERS: ; ; 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 = LINE ADDRESS 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$: CALL PRINTM ; PRINT ERROR MESSAGE TST (SS)+ ; REMOVE PARAM COUNTER 99$: MOV (MP)+,R ; ERROR BYTES ; V4-32 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 11$ ; IF SERIOUS ; V5-0 BIT #WCONT,SELECTOR(GP) BEQ 11$ ; IF NOT CONT AFTER WARNING 10$: RETURN 11$: JMP $EXITP ;----------------------------------------------------------------- MSGSZ = 58. ; MAXIMUM SIZE OF MESSAGE OF THE FORM: ; ; PASRUN -- ERROR 00. (000000) 00000. 00000. 00000. 00000. PRINTM: ; PRINT THE ERROR MESSAGE MOV HP, R0 ; SEE IF THERE IS STACK SPACE FOR SUB #MSGSZ+40., R0 ; MESSAGE BUILD AREA + MARGIN CMP R0, @#2 BHIS 2$ ; BR IF THERE IF SPACE AVAILABLE ASL (SS) ; REMOVE PARAMETERS ON SS ADD (SS), SS QIOW$S #IO.WVB,#5,#5,,,,<#M1,#M1SZ,#40> ; PRINT SHORT MESSAGE ONLY BR 80$ 2$: SUB #MSGSZ, HP ; RESERVE MESSAGE BUILD AREA ON STACK MOV HP, R0 ; POINT TO FIRST BYTE OF BUILD AREA CLR -(HP) ; "FIRST TIME" FLAG MOV #M1, R1 ; MOVE FIRST PART OF MESSAGE MOV #M1SZ, R2 ; TO BUILD AREA 4$: MOVB (R1)+, (R0)+ SOB R2, 4$ MOVB (MP), R1 ; = ERROR NUMBER BR 12$ 8$: MOV 2(SS), R1 ; = PARAM VALUE MOV (SS)+, (SS) ; REMOVE PARAM FROM LIST TST (HP) ; PRINT ONLY 1ST PARAM IN OCTAL BNE 10$ INC (HP) MOVB #'(, (R0)+ ; IN PARENTHESES MOV SS, R2 ; R2 NONZERO TO GET LEADING ZEROS CALL $CBOMG ; CONVERT TO OCTAL MOVB #'), (R0)+ BR 14$ 10$: 12$: CLR R2 ; R2 ZERO TO SUPPRESS LEADING ZEROS CALL $CBDSG ; CONVERT TO DECIMAL MOVB #'., (R0)+ 14$: MOVB #' , (R0)+ DEC (SS) ; DEC PARAM COUNTER BGE 8$ ; BR IF MORE TO DISPLAY TST (HP)+ ; REMOVE "FIRST TIME" FLAG SUB HP, R0 ; LENGTH OF MESSAGE MOV HP, R1 ; START OF MESSAGE QIOW$S #IO.WVB,#5,#5,,,, ADD #MSGSZ, HP ; DEALLOCATE MESSAGE BUILD AREA 80$: RTS PC M1: .ASCII 'PASRUN -- ERROR ' M1SZ = .-M1 .END **** P11WRI.MAC .TITLE WRI ;**************************** WRI ************************************* ; 4(SS) FILE ; 2(SS) INTEGER ; (SS) FIELD LENGTH ; ROUTINE WRI ENDWRI WRIL0: LINK WRIL1-WRIL0 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 WRIL1: LINK NOLINK 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 ;****************************** WRR ******************************** ;WRITE THE REAL IN 2(SS), 4(SS) IN FLOATING FORMAT ;FIELDLENGTH IN (SS), FILE IN 6(SS) ROUTINE WRR ENDWRR WRRL0: LINK WRRL1-WRRL0 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 WRRL1: LINK WRRL2-WRRL0 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 WRRL2: LINK WRRL4-WRRL0 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 WRRL7: LINK WRRL9-WRRL0 CALLSS NORMLZ ;NORMALIZE MOV R2,-(HP) ; DEC EXP MOV R0,-(HP) ; EXP SIGN FLAG BIC #177400,R1 ; CLEAR HIGH BYTE ; V4-14 WRRL9: LINK NOLINK CALLSS DECDIG CMP (SS)+,(SS)+ ;REMOVE REAL FROM STACK MOV #'E,-(SS) CALLSS WRC ;WRITE E MOV (HP)+,R0 ;EXP SIGN FLAG WRRL4: LINK WRRL7-WRRL0 CALLSS PRTSGN 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 NLZL0: LINK NLZL1-NLZL0 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) NLZL1: LINK NLZL2-NLZL0 CALLSS FLT ;FLOAT BINEXP MOV #20233,-(SS) MOV #37632,-(SS) ;LOAD LOG2 ON THE STACK NLZL2: LINK NLZL3-NLZL0 CALLSS MULR NLZL3: LINK NLZL4-NLZL0 CALLSS TRC ;INTEGER RAW DECEXP MOV (SS)+, R2 ;LOAD INTO R2 NLZ0: MOV R2,-(HP) ;STORE DECEXP MOV 4(HP), R0 ;SIGN FLAG NLZL4: LINK NLZL5-NLZL0 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 NLZL5: LINK NLZL6-NLZL0 CALLSS MULR ;MULTIPLY BR NLZ2 ;READY NLZ3: INC (HP) ;INCREMENT EXPONENT NLZL6: LINK NOLINK 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 MOV #14631,(SS) MOV #114700,2(SS) INC (HP) ;DECEXP BR NLZ5 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 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 DDGL0: LINK NOLINK 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 PSNL0: LINK NOLINK MOV #'+,-(SS) ;LOAD PLUS SIGN 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 TRLL0: LINK NOLINK 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 WRFL0: LINK WRFL2-WRFL0 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 WRFL2: LINK WRFL3-WRFL0 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) WRFL9: LINK WRFL10-WRFL0 CALLSS TRAILR ;PRINT LEADING BLANKS MOV 4(HP), R0 ;RESTORE SIGN OF REAL WRFL3: LINK WRFL4-WRFL0 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 WRFL10: LINK WRFL11-WRFL0 CALLSS WRR ;WRITE IN FLOATING FORMAT RTS MP WRF3: MOV 4(SS),-(SS) ;FILE MOV #' ,-(SS) WRFL4: LINK WRFL5-WRFL0 CALLSS TRAILR ;PRINT BLANKS MOV 4(HP),R0 ;SIGN WRFL11: LINK NOLINK CALLSS PRTSGN TST (SS)+ ;REMOVE FILE ID MOV (HP), R1 ;INITIATE R1 FOR DECDIG WRFL5: LINK WRFL7-WRFL0 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 WRFL7: LINK WRFL8-WRFL0 CALLSS TRAILR ; MOVB 3(HP),R1 SUB (HP), R1 ;NO OF DIGITS TO BE PRINTED WRF5: TST (SS)+ ;REMOVE FILE ID WRFL8: LINK WRFL9-WRFL0 CALLSS DECDIG CMP (SS)+,(SS)+ ;REMOVE REALS ADD #8.,HP ;REMOVE TEMPS AND REALS ENDWRF: RTS MP .END ****