github.com/PDP-10.stacken
1
0
Fork 0
mirror of https://github.com/PDP-10/stacken.git synced 2026-02-19 22:05:10 +00:00
Code Issues Projects Releases Wiki Activity
Files
6e18f5ebefd9acb0d718ef31a08f33a60fc9fca2
PDP-10.stacken/files/stacken-tape-backup/dskb:10_7/track/libfor.mac
Lars Brinkhoff 6e18f5ebef Extract files from tape images. 
Some tapes could not be extracted.
2021-01-29 10:47:33 +01:00

882 lines
16 KiB
Plaintext
Raw Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
UNIVERSAL LIBUNV - UNIVERSAL FILE FOR LIBFOR
SUBTTL DEFINE ARGUMENT RETRIEVAL MACROS
;+
;.nofill
;.nojust
;.title ####################LIBFOR - FORTRAN-10 ROUTINE LIBRARY
;.SPACING 1
;.CENTER
;PROGRAM LOGIC MANUAL FOR LIBFOR
;.CENTER
;25-AUGUST-77
;.SKI 2
;.CENTER
;Reed Powell, DEC
;.skip 10
;LIBFOR.REL[464,105]
;.PAGE
;-
DEFINE ARG1,<0(16)>
DEFINE ARG2,<1(16)>
DEFINE ARG3,<2(16)>
DEFINE ARG4,<3(16)>
DEFINE ARG5,<4(16)>
DEFINE ARG6,<5(16)>
DEFINE ARG7,<6(16)>
DEFINE ARG8,<7(16)>
DEFINE ARG9,<10(16)>
DEFINE ARG10,<11(16)>
SUBTTL DEFINE ACCUMULATOR MNEMONICS
AC0=0
AC1=1
AC2=2
AC3=3
AC4=4
AC5=5
AC6=6
AC7=7
L=16
P=17
SUBTTL PROLOGUE AND EPILOGUE MACROS
;"HELLO" IS THE PROLOGUE MACRO, USED TO DEFINE
;THE START OF A SUBROUTINE OR FUNCTION.
;"GOODBY" IS THE EPILOGUE MACRO, USED TO DEFINE THE END
;OF A SUBROUTINE OR FUNCTION.
;HELLO:
;CALL IS
; HELLO NAME,SAVCOD,ACLIST
;WHERE
; "NAME" IS THE NAME OF THE SUBROUTINE OR FUNCTION.
; "SAVCOD" IS THE NAME OF THE ROUTINE TO SAVE ACCUMULATORS.
; "ACLIST" IS A LIST OF LOCATIONS TO BE PUSHED ONTO
; THE STACK. MUST BE WITHIN <> IF MORE THAN ONE
; LOCATION IN LIST.
DEFINE HELLO(NAME,SAVCOD,ACLIST)
<
IFDEF ..NEST,<
IFN ..NEST,<PRINTX NESTED CALLS TO HELLO: NAME
END
>>
..NEST==1
ENTRY NAME
SIXBIT/NAME/
NAME:
IFNB <SAVCOD>,<PUSHJ P,SAVCOD>
IFNB <ACLIST>,
<IRP ACLIST,<
PUSH P,ACLIST
>>
>;END OF HELLO
;GOODBY:
;CALL IS
; GOODBY NAME,RSTCOD,ACLIST
;WHERE
; "NAME" IS THE NAME OF THE SUBROUTINE OR FUNCTION
; "RSTCOD" IS THE NAME OF THE ROUTINE TO RESTORE ACCUMULATORS.
; "ACLIST" IS THE LIST OF LOCATIONS TO BE POP-ED FROM
; THE STACK.
DEFINE GOODBY(NAME,RSTCOD,ACLIST)
<
IFNDEF ..NEST,<PRINTX GOODBY WITHOUT HELLO: NAME
END>
IFN ..NEST-1,<PRINTX GOODBY WITHOUT HELLO: NAME
END>
..NEST==..NEST-1
IFNB <RSTCOD>,<PUSHJ P,RSTCOD>
IFNB <ACLIST>,<
IRP ACLIST,<
POP P,ACLIST
>>
POPJ P,
>;END OF GOODBY
PRGEND ;;END OF LIBUNV
TITLE IGETTB- FORTRAN-10 INTEGER FUNCTION TO DO GETTABS
SEARCH LIBUNV
SEARCH UUOSYM,MACTEN
;+
;.SUBTITLE IGETTB - GETTAB FUNCTION
;.INDEX IGETTAB
;.INDEX GETTAB
;CALL TO "IGETTB" IS:
; IGETTB(TABLE,ITEM)
;WHERE
; "TABLE" IS AN INTEGER WITH THE TABLE NUMBER IN IT.
; "ITEM" IS AN INTEGER WITH THE ITEM NUMBER IN IT.
;ON RETURN, THE VALUE IS =-1 IF THE GETTAB FAILED, ELSE
; IT IS THE RESULT RETURNED BY THE UUO.
;.PAGE
;-
HELLO IGETTB
HRR AC0,@ARG1 ;GET TABLE NUMBER
HRL AC0,@ARG2 ;AND THE ITEM NUMBER
GETTAB AC0,
SETO AC0,
GOODBY IGETTB
PRGEND ;;END OF IGETTB
TITLE IWHERE - WHERE UUO SUBROUTINE
SEARCH LIBUNV,MACTEN,UUOSYM
;+
;.SUBTITLE IWHERE - WHERE UUO SUBROUTINE
;.INDEX IWHERE
;.INDEX WHERE UUO
;WHERE:
;CALL IS
; IWHERE(DEV,STATUS,NODE)
;WHERE
; DEV IS THE DEVICE NAME
; "STATUS" IS WHERE THE STATUS BITS ARE RETURNED
; "NODE" IS THE NUMBER OF THE NODE
;IF WHERE UUO TAKES ERROR RETURN, THEN
; -1 IS RETURNED IN BOTH "STATUS" AND "NODE".
;.PAGE
;-
HELLO IWHERE
MOVE AC0,@ARG1 ;GET DEVICE NAME
WHERE AC0,
SETO AC0,
HLREM AC0,@ARG2 ;STORE STATUS
HRREM AC0,@ARG3 ;STORE NODE NUMBER
GOODBY IWHERE
PRGEND
TITLE MISC - MISC SUBROUTINES
SUBTTL EXITS: SUBROUTINE TO DO QUICK MONRET
SEARCH LIBUNV,MACTEN,UUOSYM
;+
;.SUBTITLE EXITS - " EXIT 1, " SUBROUTINE
;.INDEX EXITS
;.INDEX EXIT
;.INDEX MONRT
;EXITS - QUICK MONRET SUBROUTINE
;CALL IS
; CALL EXITS
;.PAGE
;-
HELLO EXITS
EXIT 1,
GOODBY EXITS
;SUBROUTINE TO TURN OFF TTY ECHOING
;+
;.SUBTITLE ECHO AND NOECHO
;.INDEX ECHO
;.INDEX NOECHO
;SUBROUTINE NO ECHO - TURNS OFF TERMINAL ECHOING
;SUBROUTINE ECHO - TURNS ON TERMINAL ECHOING
;
;CALL:
; CALL NOECHO
; CALL ECHO
;-
HELLO NOECHO
SETO 1,
GETLCH 1
TXO 1,GL.LCP ;LOCAL COPY
SETLCH 1
GOODBYE NOECHO
HELLO ECHO
SETO 1,
GETLCH 1
TXZ 1,GL.LCP ;TURN OFF LOCAL COPY
SETLCH 1
GOODBYE ECHO
PRGEND
TITLE HAFWRD - FUNCTIONS TO DO HALF-WORD INSTRUCTIONS
SEARCH LIBUNV,UUOSYM,MACTEN
;+
;.SUBTITLE HAFWRD - "ILEFT" AND "IRIGHT"
;.INDEX HAFWRD
;.INDEX ILEFT
;.INDEX IRIGHT
;.SKI 2
;THESE TWO FUNCTIONS ARE USED TO DO HALF WORD MOVES OF
;DATA IN FORTRAN.
;EACH HAS AS ITS VALUE THE APPROPRIATE HALF OF THE PDP-10
;WORD WHICH IS ITS ARGUMENT.
;.PAGE
;-
HELLO ILEFT
HLRZ AC0,@ARG1
GOODBY ILEFT
HELLO IRIGHT
HRRZ AC0,@ARG1
GOODBY IRIGHT
PRGEND
TITLE ILINUM SUBROUTINE TO DO THE "GTNTN." UUO
SEARCH LIBUNV,UUOSYM,MACTEN
;+
;.SUBTITLE ILINUM - "GTNTN." UUO, GETS LINE NUMBER
;.INDEX ILINUM
;.INDEX "GTNTN."
;ILINUM:
;CALL IS
; ILINUM(TTY,NODE,LINE)
;WHERE
; "TTY" IS THE SIXBIT TTY NAME
; "NODE" IS WHERE THE NONE # IS RETURNED
; "LINE" IS WHERE THE LINE NUMBER ON THAT
; NODE IS RETURNED.
;IF GTNTN. UUO FAILS, THEN -1 IS RETURNED IN "NODE",
; AND THE ERROR CODE IS RETURNED IN "LINE":
; ERROR 0: NO SUCH DEVICE
; ERROR 1: DEVICE IS NOT A TERMINAL
; ERROR 2: SPECIFIED TERMINAL IS NOT CONNECTED
;.PAGE
;-
HELLO ILINUM
MOVE AC0,@ARG1 ;GET TERMINAL NAME
GTNTN. AC0,
TLO AC0,-1 ;SET NODE NUMBER TO -1
HLREM AC0,@ARG2 ;STORE NODE NUMBER
HRRM AC0,@ARG3 ;STORE LINE NUMBER ON NODE
GOODBY ILINUM
PRGEND
TITLE IGETTY - FUNCTION TO DO THE GTXTN. UUO
SEARCH LIBUNV,MACTEN,UUOSYM
;+
;.SUBTITLE IGETTY - "GTXTN." UUO, GETS TTY NUMBER
;.INDEX IGETTY
;.INDEX "GTXTN."
;IGETTY:
;CALL
; IGETTY(INODE,ILINE)
;WHERE
; "INODE" IS THE NODE NUMBER
; "ILINE" IS THE LINE ON THAT NODE
;ON RETURN, THE VALUE OF THE FUNCTION IS THE SIXBIT
; NAME OF THE TERMINAL CONNECTED TO THE SPECIFIED
; NODE-LINE COMBINATION, OR
;ERROR THE VALUE OF THE FUNCTION IS THE
; ERROR CODE:
; ERROR 0: NOT A NETWORK TERMINAL
; ERROR 1: NOT A LOCAL TTY
;.PAGE
;-
HELLO IGETTY
HRL AC0,@ARG1 ;GET NODE NUMBER
HRR AC0,@ARG2 ;AND LINE NUMBER
GTXTN. AC0,
JFCL ;VALUE IS THE ERROR CODE
GOODBY IGETTY
PRGEND
TITLE INODE - SUBROUTINE TO DO NODE. UUOS
SEARCH LIBUNV,UUOSYM,MACTEN
;+
;.SUBTITLE INODE - "NODE." UUO SUBROUTINE
;.INDEX INODE
;.INDEX "NODE."
;INODE:
;CALL
; CALL INODE(IFUNCT,IARRY,IERR)
;WHERE:
; "IFUNCT" IS THE FUNCTION CODE FOR NODE.
; "IARRY" IS THE NAME OF THE ARGUMENT BLOCK ARRAY.
; "IERR" IS THE ERROR STATUS WORD:
; IF 0, THEN CALL WAS SUCCESSFUL,
; IF NON-0, THEN IT IS THE ERROR CODE RETURNED BY NODE.:
; ERROR 1: "IARRY" NOT SET UP PROPERLY
; ERROR 2: ILLEGAL NODE NAME OR NUMBER
; ERROR 3: NOT A PRIVILEGED JOB
; ERROR 4: NODE IS NOT AVAILABLE
; ERROR 5: JOB NOT LOCKED IN CORE AND MUST BE
; ERROR 6: TIME-OUT ERROR OCCURRED
; ERROR 7: IARRY(3) NON-0 FOR FUNCTION #5
;.PAGE
;-
HELLO INODE
HRL AC0,@ARG1 ;GET FUNCTION CODE
HRR AC0,@ARG2 ;GET ARG-BLOCK ADDRESS
SETZM @ARG3 ;ASSUME WILL BE OK
NODE. AC0,
MOVEM AC0,@ARG3 ;STORE ERROR CODE
GOODBY INODE
PRGEND
TITLE ISIXBT - FUNCTION TO CONVERT FROM ASCII TO SIXBIT
SEARCH LIBUNV,MACTEN,UUOSYM
;+
;.SUBTITLE ISIXBT _& IASCII - SIXBIT/ASCII CONVERSION FUNCTIONS
;.INDEX ISIXBT
;ISIXBT:
;CALL
; ISIXBT(IASCII,LIMIT)
;WHERE:
; "IASCII" IS THE ASCII WORD
; "LIMIT" IS THE MAX CHARS TO CONVERT
;.SKIP 10
;-
HELLO ISIXBT,,<AC2,AC3,AC4>
MOVE AC1,[POINT 7,@ARG1] ;ASCII PTR
MOVE AC2,[POINT 6,AC0] ;SIXBIT PTR
MOVN AC3,@ARG2 ;ITERATION CTR
SETZ AC0,
LOOP: ILDB AC4,AC1 ;GET ASCII CHAR
JUMPE AC4,DONE ;DONE IF A NUL
SUBI AC4,"0"-'0' ;ASCII TO SIXBIT
IDPB AC4,AC2 ;STORE SIXBIT
AOJL AC3,LOOP
DONE: GOODBY ISIXBT,,<AC4,AC3,AC2>
PRGEND
TITLE IASCII - FUNCTION TO CONVERT SIXBIT TO ASCII
SEARCH LIBUNV,MACTEN,UUOSYM
;+
;.INDEX IASCII
;IASCII:
;CALL
; IASCII(ISIXBT,LEN)
;WHERE
; ISIXBT IS THE SIXBIT WORD TO BE CONVERTED
; "LEN" IS THE MAX NUMBER OF CHARS TO CONVERT
;.PAGE
;-
HELLO IASCII,,<AC2,AC3,AC4>
MOVE AC1,[POINT 6,@ARG1] ;SIXBIT PTR
MOVE AC2,[POINT 7,AC0] ;ASCII PTR
MOVN AC3,@ARG2 ;INTERATION CTR
MOVE AC0,[ASCII/ /]
LOOP: ILDB AC4,AC1 ;GET SIXBIT
JUMPE AC4,DONE ;DONE IF SPACE
ADDI AC4,"0"-'0' ;SIXBIT TO ASCII
IDPB AC4,AC2 ;STORE ASCII
AOJL AC3,LOOP
DONE: GOODBY IASCII,,<AC4,AC3,AC2>
PRGEND
TITLE LOGIC - FUNCTIONS TO PERFORM DEC-10 LOGICAL FUNCTIONS
SUBTTL ROTATING, SHIFTING
SEARCH LIBUNV,UUOSYM,MACTEN
;+
;.SUBTITLE LOGIC - FUNCTIONS FOR DEC-10 LOGICAL INSTRUCTIONS
;.INDEX IROTAT
;.INDEX ROT
;IROTAT:
;CALL:
; IROTAT(IWORD,IBITS)
;WHERE
; "IWORD" IS WORD TO BE ROTATED
; "IBITS" IS NUMBER OF POSITIONS TO ROTATE (SIGNED INTEGER)
;.SKIP 10
;-
HELLO IROTAT
MOVE AC0,@ARG1 ;WORD TO ROTATE
MOVE AC1,@ARG2 ;POSITIONS TO ROTATE
ROT AC0,(AC1)
GOODBY IROTAT
;+
;.INDEX ILSHFT
;.INDEX LSH
;ILSHFT:
;CALL
; ILSHFT(IWORD,IBITS)
;WHERE
; "IWORD" IS WORD TO SHIFT BITS OF
; "IBITS" IS NUMBER OF POSITIONS TO SHIFT (SIGNED INTEGER)
;.SKIP 10
;-
HELLO ILSHFT
MOVE AC0,@ARG1 ;GET WORD
MOVE AC1,@ARG2 ;GET NUM BITS TO MOVE
LSH AC0,(AC1)
GOODBY ILSHFT
;.INDEX IASHFT
;.INDEX ASH
;IASHFT:
;CALL
; IASHFT(IWORD,IBITS)
;WHERE
; "IWORD" IS WORD TO SHIFT BITS OF
; "IBITS" IS NUMBER OF POSITIONS TO SHIFT (SIGNED INTEGER)
;.PAGE
;-
HELLO IASHFT
MOVE AC0,@ARG1 ;GET WORD
MOVE AC1,@ARG2 ;GET NUM BITS TO MOVE
ASH AC0,(AC1)
GOODBY IASHFT
SUBTTL AND, IOR, COMP, XOR, EQV, CLEAR-BIT FUNCTIONS
;+
;.INDEX AND
;.INDEX IOR
;.INDEX COMP
;.INDEX SETC
;.INDEX XOR
;.INDEX EQV
;.INDEX CLEAR-BIT
;.INDEX ANDC
;FUNCTION NAME DEC-10 INSTRUCTION PERFORMED
;IAND AND
;IOR IOR
;ICOMP SETCM
;IXOR XOR
;IEQV EQV
;ICLEAR ANDCM (BIT-CLEAR)
;CALLING SEQUENCE
; FUNCTION-NAME(WORD,MASK)
;WHERE
; "WORD" IS THE WORD WHOSE CONTENTS ARE TO
; BE USED AS INPUT (IT IS NOT ALTERED)
; "MASK" IS THE 36-BIT QUANTITY TO BE USED
; AS THE MASK FOR THE OPERATION
;NOTE THAT "ICOMP" HAS ONLY THE "WORD" ARGUMENT
;.PAGE
;-
HELLO IAND
MOVE AC0,@ARG1
AND AC0,@ARG2
GOODBY IAND
HELLO IOR
MOVE AC0,@ARG1
IOR AC0,@ARG2
GOODBY IOR
HELLO ICOMP
MOVE AC0,@ARG1
SETCM AC0
GOODBY ICOMP
HELLO XOR
MOVE AC0,@ARG1
XOR AC0,@ARG2
GOODBY XOR
HELLO ICLEAR
MOVE AC0,@ARG1
ANDCM AC0,@ARG2
GOODBY ICLEAR
HELLO IEQV
MOVE AC0,@ARG1
EQV AC0,@ARG2
GOODBY IEQV
PRGEND
TITLE BYTE - PERFORM DEC-10 BYTE OPERATIONS
SUBTTL MAKEBP - CONSTRUCT BYTE-POINTERS
SEARCH LIBUNV,MACTEN,UUOSYM
;+
;.SUBTITLE BYTE - FUNCTIONS FOR DEC-10 BYTE MANIPULATION
;.INDEX BYTE-MANIPULATION
;.INDEX MAKEBP
;MAKEBP:
;FUNCTION TO MAKE A DEC-10 STYLE BYTE-POINTER
;CALL
; MAKEBP(IWORD,IPOS,ISIZE)
;WHERE
; "IWORD" IS THE WORD CONTAINING THE BYTE(S)
; "IPOS" IS THE BYTE'S POSITION, A LA "POINT" PSEUDO-OP
; IN MACRO-10
; "ISIZE" IS THE SIZE OF THE BYTE
;THE VALUE RETURNED BY THE FUNCTION IS THE BYTE-POINTER
;CONSTRUCTED. NO VALIDITY CL`HECKING OF THE ARGUMENTS IS
;PERFORMED.
;.SKI 5
;-
HELLO MAKEBP
MOVE AC1,@ARG2 ;GET POS FIELD
MOVNS AC1
ADDI AC1,^D35 ;CONVERT TO HARDWARE POSITION
LSH AC1,^D6 ;AND POSITION IN PTR
MOVE AC0,@ARG3 ;GET SIZE FIELD
IOR AC0,AC1 ;COMBINE POS AND SIZE
LSH AC0,^D24 ;AND POSITION THEM
HRR AC0,ARG1 ;GET **ADDRESS** OF MEMORY WORD
GOODBY MAKEBP
SUBTTL GETBYT AND PUTBYT SUBROUTINES
;+
;.INDEX GETBYT
;.INDEX PUTBYT
;GETBYT:
;PUTBYT:
;.SKI 1
;GETBYT GETS A BYTE FROM A MEMORY WORD
;PUTBYT DEPOSITS A BYTE INTO A MEMORY WORD
;CALLING FORMAT (FOR BOTH)
; CALL XXXBYT(IPTR,IBYTE,INCFLG)
;WHERE
; "IPTR" IS A DEC-10 BYTE-POINTER WORD
; "IBYTE" IS THE BYTE INVOLVED IN THE OPERATION
; "INCFLG" IS 0 IF NOT TO ADVANCE TO THE NEXT
; BYTE BEFORE PERFORMING THE OPERATION, ELSE
; NON-0 TO INCREMENT THE POINTER BEFORE THE OPERATION.
;NOTE THAT IF IN INCREMENTAL MODE, THE POINTER ITSELF IS
;MODIFIED UPON RETURN FROM THE SUBROUTINE.
;.PAGE
;-
HELLO GETBYT
SKIPE @ARG3 ;INCREMENTAL MODE??
IBP @ARG1 ;YES
LDB AC0,@ARG1
MOVEM AC0,@ARG2
GOODBY GETBYT
HELLO PUTBYT
SKIPE @ARG3 ;INCREMENTAL MODE ??
IBP @ARG1 ;YES
MOVE AC0,@ARG2 ;GET BYTE TO STORE
DPB AC0,@ARG1
GOODBY PUTBYT
PRGEND
TITLE UV2BIN - UNIVERSAL DATE/TIME SUBROUTINE
SEARCH LIBUNV
.REQUEST SCAN
;+
;.INDEX DATE
;.INDEX TIME
;.INDEX UNIVERSAL DATE/TIME
;.INDEX UV2BIN
;CALL:
; CALL UV2BIN(DATE,TIME,YEAR,MONTH,DAY,HOUR,MIN,SEC)
;WHERE:
; DATE IS THE UNIVERSAL DATE
; TIME IS THE UNIVERSAL TIME
; YEAR GETS THE YEAR NUMBER
; MONTH GETS THE MONTH NUMBER (1-12)
; DAY GETS THE DAY OF MONTH
; HOUR GETS THE HOUR OF DAY
; MIN GETS THE MINUTE OF THE HOUR
; SEC GETS THE SECOND OF THE MINUTE
;
;ALL VARIABLES ARE INTEGER
;
;USE OF THIS SUBROUTINE REQUIRES THAT SCAN BE LOADED ALSO
;
;.PAGE
;-
HELLO UV2BIN,,<AC1,AC2,AC3,AC4>
HRLZ AC1,@ARG1 ;GET DATE
HRR AC1,@ARG2 ;AND TIME
PUSHJ P,.CNTDT## ;LET SCAN CONVERT TO DEC FORMAT
PUSH P,AC1 ;SAVE TIME FOR LATER
MOVE AC1,AC2 ;GET DATE
IDIVI AC1,^D31 ;GET DAYS
MOVE AC3,AC1
MOVEI AC1,1(AC2) ;COMPUTE DAY
MOVEM AC1,@ARG5 ;STORE DAY
IDIVI AC3,^D12
MOVEI AC1,1(AC4) ;GET MONTH INDEX
MOVEM AC1,@ARG4 ;STORE MONTH
MOVEI AC1,^D64(AC3)
IDIVI AC1,^D100
MOVEM AC2,@ARG3 ;STORE YEAR OF CENTURY
;TIME
POP P,AC1
IDIV AC1,[^D3600000]
MOVEM AC1,@ARG6 ;STORE HOURS
IDIVI AC2,^D60000
MOVEM AC2,@ARG7 ;STORE MINUTES
IDIVI AC2,^D100
MOVEM AC2,@ARG8 ;STORE SECONDS
GOODBY UV2BIN,,<AC4,AC3,AC2,AC1>
PRGEND
TITLE ISIX2B - CONVERT SIXBIT TO BINARY
SEARCH LIBUNV
;+
;.INDEX ISIX2B
;.INDEX SIXBIT
;CALL:
; I=ISIX2B(J)
;WHERE:
; J IS THE SIXBIT WORD
; I IS WHERE THE BINARY FORM GOES
;ALL VARIABLES ARE INTEGER
;.PAGE
;-
HELLO ISIX2B
MOVE AC2,@ARG1
SETZ AC1, ;AC1 GETS SIXBIT BINARY
LOOP: ROT AC2,3 ;LOSE THE FIRST BYTE
ROTC AC1,3 ;GET THE BINARY PORTION
JUMPN AC2,LOOP ;UNTIL NOTHING LEFT
MOVE AC0,AC1
GOODBY ISIX2B
PRGEND
TITLE IB2SIX - CONVERTS BINARY TO SIXBIT
SEARCH LIBUNV
;+
;.INDEX IB2SIX
;.INDEX SIXBIT
;CALL:
; I=IB2SIX(J)
;WHERE:
; J IS THE BINARY NUMBER
; I IS WHERE THE SIXBIT FORMAT GOES
;N.B.: ONLY THE LOW ORDER 6 OCTAL DIGITS
; IN J ARE CONVERTED
;.PAGE
;-
HELLO IB2SIX
MOVE AC1,@ARG1
SETZ AC2, ;AC2 GETS THE SIXBIT
MOVEI AC3,6 ;MAX CHARS TO MAKE
LOOP: ROTC AC1,-3 ;GET BINARY BYTE
ROT AC2,-3 ;MAKE ROOM FOR SIXBIT
TLO AC2,200000
SKIPE AC1 ;DONE YET?
SOJG AC3,LOOP
MOVE AC0,AC2
GOODBY IB2SIX
PRGEND
TITLE NODENM - GET THE NAME OF A NETWORK NODE
SEARCH LIBUNV,UUOSYM,MACTEN
;+
;.INDEX NODENM
;.INDEX NODE NAME
;CALL:
; I=NODENM(J)
;WHERE:
; J IS THE NODE NUMBER
; I IS WHERE THESIXBIT NODE NAME IS RETURNED,
; OR 0 IF THE NODE NUMBER IS INVALID.
;.PAGE
;-
HELLO NODENM
MOVE AC1,@ARG1
MOVEM AC1,ARGBLK+1 ;POSITION NODE NUMBER
MOVE AC1,[.NDRNN,,ARGBLK]
NODE. AC1,
SETZ AC1, ;BAD NODE NUMBER
MOVE AC0,AC1
GOODBY NODENM
ARGBLK: 2 ;NUMBER OF ARGS
BLOCK 1 ;NODE # GOES HERE
PRGEND
TITLE CCTRAP - SUBROUTINES TO TRAP ^C FROM FORTRAN PROGS
SUBTTL SUBROUTINES "CCINT" AND "CCLEAR"
SEARCH LIBUNV,UUOSYM,MACTEN
;+
;.INDEX CCTRAP
;.INDEX CCINT
;.INDEX CCLEAR
;.PAGE
;SUBROUTINE CCINT - TRAPS ^C TO FORTRAN PROGRAM
;.SKIP 1
;CALL IS:
; CALL CCINT($NNN)
;WHERE "NNN" IS THE STATEMENT NUMBER IN THE FORTRAN
; PROGRAM TO GOTO WHENEVER THE ^C IS TYPED
;.SKIP 4
;SUBROUTINE CCLEAR - CLEARS ^C TRAPPING
;.SKIP 1
;CALL IS:
; CALL CCLEAR
;-
HELLO CCINT
MOVE 1,ARG1
HRRM 1,INTBLK ;STORE INTERRCEPT ADDRESS
MOVEI 1,INTBLK
MOVEM 1,.JBINT##
GOODBYE CCINT
HELLO CCLEAR
SETZM .JBINT##
GOODBYE CCLEAR
INTBLK: XWD 4,0 ;LENGTH. ADDR IS FILLED IN BY CCINT
EXP ER.ICC ;TRAP ^C
Z
Z
PRGEND
TITLE ITRMOP - PERFORM TRMOP. UUO FUNCTIONS
SEARCH LIBUNV,UUOSYM,MACTEN
;+
;ITRMOP - FUNCTION TO DO TRMOP UUOS FOR FORTRAN PROGRAMS
;CALL IS:
; X=ITRMOP(IUDX,IFUNCT,ISKIP)
;WHERE:
; IUDX IS THE UDX OF THE LINE
; IFUNCT IS THE TRMOP FUNCTION CODE
; ISKIP WILL BE TRUE IF TRMOP SKIPED,
; FALSE IF IT DID NOT SKIP
;IF ERROR RET IS TAKEN FOR FUNCTIONS HAVING ONE, THEN
;"ISKIP" WILL BE FALSE, AND THE FUNCTION'S VALUE WILL
;BE THE ERROR CODE GIVEN BY THE MONITOR.
;.INDEX TRMOP
;.INDEX ITRMOP
;-
HELLO ITRMOP
MOVE AC0,[2,,AC2] ;POINTER FOR UUO
HRRZ AC3,@ARG1 ;GET UDX
MOVE AC2,@ARG2
SETO AC1, ;SET ISKIP TO .TRUE.
TRMOP. AC0,
SETZ AC1, ;SET FLAG TO FALSE (NO SKIP)
MOVEM AC1,@ARG3 ;AND STORE INTO ISKIP
GOODBYE ITRMOP
;+
;.PAGE
;.DO INDEX
;-
END
Reference in New Issue View Git Blame Copy Permalink