Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_FS_1_19910112
-
c/user/libord/formac.mac
There is 1 other file named formac.mac in the archive. Click here to see a list.
;SS:<SOURCES.UNSUPPORTED>FORMAC.MAC.50, 22-Jan-86 23:01:18, Edit by WANCHO
; Added simple GETERR subroutine
;PS:<SOURCES.UNSUPPORTED>FORMAC.MAC.49, 29-May-85 15:48:03, Edit by WANCHO
; Changed clear screen sequence for Tektronix 4014
;PS:<SOURCES.UNSUPPORTED>FORMAC.MAC.48, 28-May-85 12:12:16, Edit by WANCHO
; Added terminal types from MM's BLANKT for PANDA MONITR as well as
; code from same in CLEAR.
;PS:<SOURCES.UNSUPPORTED>FORMAC.MAC.47, 24-Jan-85 16:18:22, Edit by WANCHO
;Fixed DOJSYS to check the correct arg for type (was checking -1)
; UPD ID= 32, PS:<SUPPORT.LIBRARIES>FORMAC.MAC.46, 26-Oct-84 15:22:37 by DUGGAN
;Fix JSERR and JSHLT
; UPD ID= 31, PS:<SUPPORT.LIBRARIES>FORMAC.MAC.45, 12-Jun-84 12:21:25 by DUGGAN
;Add MENTOR to the clear routine
; UPD ID= 30, PS:<SUPPORT.LIBRARIES>FORMAC.MAC.44, 8-Jun-84 12:43:23 by DUGGAN
;Add routines MOVE, JOBENV, PARSE from SANCAM
; UPD ID= 29, PS:<SUPPORT.LIBRARIES>FORMAC.MAC.43, 14-May-84 13:43:36 by DUGGAN
;Fix typo in TTYINT routine help message.
; UPD ID= 28, PS:<SUPPORT.LIBRARIES>FORMAC.MAC.42, 21-Mar-84 09:09:18 by DUGGAN
;Put routines jserr0 and jshlt0 here
; UPD ID= 27, PS:<SUPPORT.LIBRARIES>FORMAC.MAC.41, 20-Feb-84 12:36:31 by DUGGAN
;Fix terminal support for Tektronix 4015 (it wasn't waiting on clear)
; UPD ID= 26, PS:<SUPPORT.LIBRARIES>FORMAC.MAC.40, 9-Feb-84 14:35:05 by DUGGAN
;Add Tektronix 4105 terminal type
; UPD ID= 23, PS:<SUPPORT.LIBRARIES>FORMAC.MAC.39, 4-Feb-83 06:09:09 by SAMUELSON
; fix BEEP to run in a non-zero section (XSFRK% not SFORK%)
; UPD ID= 22, PS:<SUPPORT.LIBRARIES>FORMAC.MAC.38, 7-Jan-83 08:07:33 by SAMUELSON
; Add FTSHR and FTPSCT
; UPD ID= 21, PS:<SUPPORT.LIBRARIES>FORMAC.MAC.37, 16-Nov-82 14:02:04 by SAMUELSON
; Fix TTYINT in case FLAGS. loaded above 1,,400000
; UPD ID= 20, PS:<SUPPORT.LIBRARIES>FORMAC.MAC.36, 15-Nov-82 19:59:13 by SAMUELSON
; fix TTYINT for extended addressing (required patch to FOROTS too).
; UPD ID= 16, PS:<SUPPORT.LIBRARIES>FORMAC.MAC.35, 9-Oct-82 14:35:38 by SAMUELSON
; changed name of ICHAR to NCHAR to avoid conflict with FORTRAN-77 intrinsic function
; UPD ID= 15, PS:<SUPPORT.LIBRARIES>FORMAC.MAC.34, 20-Sep-82 15:36:44 by SAMUELSON
; add fortran-77 support to DOJSYS
; UPD ID= 14, PS:<SUPPORT.LIBRARIES>FORMAC.MAC.33, 20-Sep-82 11:05:28 by SAMUELSON
; fixup error handling in DOJSYS
; UPD ID= 13, PS:<SUPPORT.LIBRARIES>FORMAC.MAC.32, 9-Sep-82 11:11:45 by SAMUELSON
; add routines BEEP/NOBEEP and EXTADR
; UPD ID= 12, PS:<SUPPORT.LIBRARIES>FORMAC.MAC.31, 9-Sep-82 10:02:40 by SAMUELSON
; fix bug in use of global byte pointers
; UPD ID= 11, PS:<SUPPORT.LIBRARIES>FORMAC.MAC.30, 7-Sep-82 13:41:12 by SAMUELSON
; UPD ID= 10, PS:<SUPPORT.LIBRARIES>FORMAC.MAC.29, 7-Sep-82 12:33:07 by SAMUELSON
; fix bug in ICHAR (BLDPTR) in last previous edit
; UPD ID= 9, PS:<SUPPORT.LIBRARIES>FORMAC.MAC.27, 2-Sep-82 10:37:43 by SAMUELSON
; more support for extended addressing and fortran-77
; UPD ID= 8, PS:<SUPPORT.LIBRARIES>FORMAC.MAC.26, 22-Aug-82 15:14:58 by SAMUELSON
; UPD ID= 7, PS:<SUPPORT.LIBRARIES>FORMAC.MAC.25, 21-Aug-82 14:29:50 by SAMUELSON
; UPD ID= 6, PS:<SUPPORT.LIBRARIES>FORMAC.MAC.24, 18-Aug-82 17:26:50 by SAMUELSON
; UPD ID= 5, PS:<SUPPORT.LIBRARIES>FORMAC.MAC.23, 17-Aug-82 21:50:21 by SAMUELSON
; UPD ID= 4, PS:<SUPPORT.LIBRARIES>FORMAC.MAC.22, 17-Aug-82 11:32:02 by SAMUELSON
; UPD ID= 3, PS:<SUPPORT.LIBRARIES>FORMAC.MAC.21, 13-Aug-82 16:16:32 by SAMUELSON
; UPD ID= 1, PS:<SUPPORT.LIBRARIES>FORMAC.MAC.20, 13-Aug-82 09:37:35 by SAMUELSON
;+.FT.rm 72.TITLE FORMAC - A MACRO library for FORTRAN programs
;.C ;Description of programs in the library FORMAC
;.c ;December 29, 1982
;.c ;Norm Samuelson, 2644
;.b1.nj;All of the routines described in this document are
;available in the relocatable library FORMAC.
;(The source is in MAC:FORMAC.MAC).
;To access any or all of these subroutines, simply add
;.i10;SYS:FORMAC.REL/SEARCH
;. ;to your LOAD, EXECUTE, or DEBUG command,
;or to the LINK commands used in loading complex programs.
;.b1;There are now three variants of FORMAC.
;.ls.le;FORMAC.REL - traditional version, all LOWSEG
;.le;FORMAS.REL - sharable version, TWOSEG
;for use with fortran code loaded with /SEGMENT:DEFAULT.
;.le;FORMAP.REL - psected version, psect names are .CODE. and .DATA.
;for use with FORTRAN code compiled with the /EXTEND switch.
;.els.b1;All of these routines are designed to be called from
;FORTRAN programs. Some can be called from COBOL also.
;Some are FUNCTIONS, others are SUBROUTINES
;(see comments with each one).
;.b1;The source file contains RUNOFF input to produce this
;documentation. To get a copy type the command:
;.i8;RUNOFF TTY:=MAC:FORMAC.MAC
;.I5;or RUNOFF LPT:=MAC:FORMAC.MAC
;-
UNIVERSAL SLAUNV - DEFINE SANDIA DEFAULTS
SUBTTL NH SAMUELSON, 2641, 4/76
COMMENT \
This file defines common symbols used in many Sandia programs
It is accessable to anyone by simply adding the statement
SEARCH SLAUNV
To your MACRO source.
This has been included in FORMAC to put all the required sources
into a single file to make distribution easier.
\
DEFINE ND (NAME,VALUE),<IFNDEF NAME,<NAME==VALUE>>
ND FTN77,1 ;include support for FORTRAN-77
;ie: character string descriptors
ND ftjsys,-1 ;ON FOR TOPS-20
ND FTPSCT,0 ;ON FOR PSECTS .CODE. AND .DATA.
ND FTSHR,0 ;ON FOR TWOSEG
if1,<
ife ftjsys,<PRINTX BUILDING UNIVERSALS FOR TOPS10>
IFN ftjsys,<PRINTX BUILDING UNIVERSALS FOR TOPS20>
PAGSIZ==1000
IFN FTPSCT,<PRINTX PSECTED VERSION>
IFE FTPSCT,<
IFN FTSHR,<PRINTX TWOSEG VERSION>
IFE FTSHR,<PRINTX LOWSEG VERSION>
>;IFE FTPSCT
>;if1
;IO CHANNELS
ife ftjsys,<
DSK==1
LPT==2
MTA==3
SYS==4
MFD==5
UFD==6
PTY==7
LOG==10
LST==11
CMD==12
TTY==13
>;END ife ftjsys
;ACCUMULATORS
F=0
syn f,t0 ;t0 is a synonym for f
T1=1
T2=t1+1
T3=t2+1
T4=t3+1
t5=t4+1
P1=t5+1
P2=p1+1
P3=p2+1
P4=p3+1
ap=16
P=17
STKSIZ==20
;special ppn's
ife ftjsys,<
SYSPPN==1,,4
OPRPPN==1,,2
QUEPPN==3,,3
NIKPPN==2,,20
>;END ife ftjsys
.CHSPC==" " ;SPACE
.TTHP==4 ;HP2624
.TTADM==5 ;ADM3a
.TTTEK==6 ;TEKTRONIX
.TTTK5==7 ;TEKTRONIX 4015
.TTH19==23 ;Heath H19
.TTCCI==24 ;COMPUCOLOR
.TTTK1==25 ;Tektronix 4105
subttl MACRO DEFINITIONS
;The SEGMENT macro was taken from MTHPRM.MAC (part of FOROTS)
;and changed to generate THREE versions. (see FTSHR)
;SEGMENT MACRO
; DEFINES SEGMENTS IN TERMS OF PSECTS (FTPSCT==-1)
; OR LOW/HIGH RELOCS (FTPSCT==0)
; .PSECTS TO SEGMENT 'S', WITH ATTRIBUTE SWITCHS 'ATR'
; CURRENT SEGMENTS ARE CODE, DATA, AND ERR
IFN FTPSCT,<
DEFINE SEGMENT (SNAME) <
IFDEF $SEG$,<
IF1,<IFE <$SEG$-1>,<.ENDPS>>
IF2,<IFE <$SEG$-2>,<.ENDPS>
IFN <$SEG$-2>,<$SEG$==2>
> ;END IF2
> ;END IFDEF $SEG$
IFNDEF $SEG$,<
IF1,< $SEG$==1>
IF2,< $SEG$==2>
> ;END IFNDEF
.PSECT .'SNAME'.
$NAME$==''SNAME''
> ;END SEGMENT
> ;END IFN FTPSCT
IFE FTPSCT,<
IFN FTSHR,<
DEFINE SEGMENT (SNAME) <
IFDEF $SEG$,<
IF2,<
IFE <$SEG$-1>,<$SEG$==2
TWOSEG 400000
> ;END IFE $SEG$-1
IFE <$SEG$+1>,<$SEG$==2
TWOSEG 400000
> ;END IFE $SEG$+1
> ;END IF2
> ;END IFDEF $SEG$
IFNDEF $SEG$,<
TWOSEG 400000
IF1,< $SEG$==1>
IF2,< $SEG$==2>
> ;END IFNDEF $SEG$
$NAME$==''SNAME''
IFIDN <SNAME><DATA>,<
IFG $SEG$,<
RELOC
IF1,< $SEG$==-1>
IF2,< $SEG$==-2>>>
IFDIF <SNAME><DATA>,<
IFL $SEG$,<
RELOC
IF1,< $SEG$==1>
IF2,< $SEG$==2>>>
> ;END SEGMENT
>;END IFN FTHSR
IFE FTSHR,<
DEFINE SEGMENT (NAME),<> ;nothing
>;END IFE FTSHR
> ;END IFE FTPSCT
DEFINE XBLT (AC),<
EXTEND AC,[020B8]
>
DEFINE MAKSTK,<MOVE P,[IOWD STKSIZ,STAK]>
DEFINE FXCASE (AC),<
CAIL AC,"a"
SUBI AC,"a"-"A"
>
DEFINE HELLO (EP),<
SIXBIT/EP/
EP: ENTRY EP
>;END HELLO MACRO
DEFINE SLAPLG(%ID),< ;STANDARD PROLOGUE
SALL
.DIRECT SFCOND
.DIRECT FLBLST
IFN FTJSYS,<SEARCH MONSYM, MACSYM>
IFE FTJSYS,<
SEARCH UUOSYM, MACTEN
DEFINE TMSG(%TEXT),<OUTSTR [ASCIZ/%TEXT/]>
>
IFNB <%ID>,<
ND %ID'VER,1 ;DEFAULT VERSION NUMBER
ND %ID'MVR,0 ;MINOR VERSION
ND %ID'EDT,0 ;EDIT NUMBER
ND %ID'WHO,1 ;WHO (NON-DEC)
VERNUM==BYTE(3)%ID'WHO(9)%ID'VER(6)%ID'MVR(18)%ID'EDT
>>;END PROLOGUE
;USEFUL OPDEFs
;STATES WORD - SCHED BITS
ife ftjsys,<
ST%SPO==1B18 ;SYSTEM PROGRAMMERS ONLY
ST%MSG==1B19 ;SPECIAL MESSAGE IN "SYS:MESSAG.TXT"
;(USED BY LOGIN, REPORTED BY OTHERS)
;BITS IN RIBPCA - PRIV CUST ARG IN RIB OF EACH FILE
RB%PRG==1B18 ;THIS FILE IS TO BE PURGED
>;END ife ftjsys
;MISC DEFINITIONS
MAXINT==377777,,777777
;NBS DATE TIME UNITS
NBSDAY==1B17
NBSHR==NBSDAY/^D24
NBSMIN==NBSHR/^D60
NBSSEC==NBSMIN/^D60
subttl macros for COMND JSYS calls
ifn ftjsys,<
;Key - define an entry in a keyword table. It takes one to three arguemnts.
;The first argument is the keyword.
;The second argument is the value to be associated with the keyword.
;If omitted it defaults to a value of "." concatenated with the keyword,
;ie: key foo####would have a value of ".FOO"
;The third argument is a combination of flag bits.
;[if more than one flag bit is specified they should be separated by
;exclamation points (!).]
;
define key(nam,val,bits),<
ifnb <val>,<
ifb <bits>,<[asciz/nam/],,val> ;;normal case
ifnb <bits>,<[cm%fw!bits ;;bits are messy but useful
[asciz/nam/]],,val>
>
ifb <val>,<
ifb <bits>,<[asciz/nam/],,.'nam> ;;normal case
ifnb <bits>,<[cm%fw!bits ;;bits are messy but useful
[asciz/nam/]],,.'nam>
>
>;end key macro
;.b1;IKEY - KEY with invisible bit set
define IKEY(nam,val,bits<0>),<
KEY(nam,val,cm%inv!bits)
>;end IKEY macro
;.b1;TV - even easier than KEY, value is just index into keyword table.
define TV(nam),<
zzzz==zzzz+1 ;;increment value
key(nam,zzzz)
>;end TV macro
;.b1;ITV - same as TV but invisible.
define ITV(nam),<
zzzz==zzzz+1
ikey(nam,zzzz)
>;end ITV macro
>;end ifn ftjsys
PRGEND
Title SHIFT - single word shift and rotate routines
subttl NH Samuelson, 2641, 8/2/78
SEARCH SLAUNV
SLAPLG ;STANDARD PROLOGUE
;+.HL1 SHIFT routines
;.nj;The following group of FUNCTIONS are special case routines
;to produce results equivalent to the strange SHIFT FUNCTION found
;on CDC 6600 and 7600 computers.
;.b1.nf;Calling sequence:
; SHIFT(W,N) left=circular right=sign extended
; or ASH(W,N) left=zero fill right=sign extended
; or LSH(W,N) left=zero fill right=zero fill
; or ROT(W,N) left=curcular right=circular
; where W is a SINGLE WORD quantity to be shifted
; and N is the SHIFT COUNT (+=LEFT, -=RIGHT)
;.b1.f.nj;The FUNCTION to be used should be declared LOGICAL in the
;-calling program.
WORD==0
COUNT==1
SEGMENT CODE
HELLO SHIFT
SKIPL T1,@COUNT(AP) ;IS COUNT NEGATIVE?
JRST ROT.. ;NO - POSITIVE = ROTATE LEFT
JRST ASH.. ;YES - RIGHT WITH SIGN EXTENSION
HELLO ASH
MOVE T1,@COUNT(AP)
ASH..: MOVE T0,@WORD(AP)
ASH T0,(T1)
RET
HELLO ROT
MOVE T1,@COUNT(AP)
ROT..: MOVE T0,@WORD(AP)
ROT T0,(T1)
RET
HELLO LSH
MOVE T1,@COUNT(AP)
MOVE T0,@WORD(AP)
LSH T0,(T1)
RET
PRGEND
Title DSHIFT - DOUBLE PRECISION shift and rotate routines
subttl NH Samuelson, 2641, 8/2/78
SEARCH SLAUNV
SLAPLG ;STANDARD PROLOGUE
;+.HL1 DSHIFT routines
;.F.nj;The following group of DOUBLE PRECISION FUNCTIONS are
;special case routines to produce results equivalent to the strange
;SHIFT FUNCTION found on CDC 6600 and 7600 computers.
;.b1.nf;Calling sequence:
; DSHIFT(DD,N) left=circular right=sign extended
; DASH(DD,N) left=zero fill right=sign extended
; DLSH(DD,N) left=zero fill right=zero fill
; DROT(DD,N) left=curcular right=circular
; where DD is a DOUBLE WORD quantity to be shifted
; and N is the SHIFT COUNT (+=LEFT, -=RIGHT)
;.b1.f.nj;The FUNCTION to be used should be delcared DOUBLE PRECISION
;-in the calling program.
WORDS==0
COUNT==1
SEGMENT CODE
HELLO DSHIFT
PUSH P,T2
SKIPL T2,@COUNT(AP)
JRST DROT.. ;NO - POSITIVE = ROTATE LEFT
JRST DASH.. ;YES - RIGHT WITH SIGN EXTENSION
HELLO DASH
PUSH P,T2
MOVE T2,@COUNT(AP)
DASH..: DMOVE T0,@WORDS(AP)
ASHC T0,(T2)
JRST T2POPJ
HELLO DROT
PUSH P,T2
MOVE T2,@COUNT(AP)
DROT..: DMOVE T0,@WORDS(AP)
ROTC T0,(T2)
JRST T2POPJ
HELLO DLSH
PUSH P,T2
MOVE T2,@COUNT(AP)
DMOVE T0,@WORDS(AP)
LSHC T0,(T2)
T2POPJ: POP P,T2
RET
PRGEND
Title MASK - generate an N-bit mask (single or double precision)
Subttl NH Samuelson, 2641, 10/79
SEARCH SLAUNV
SLAPLG ;STANDARD PROLOGUE
;+.HL1 MASK function
;.f.nj;The MASK function generates a mask of up to 72 bits, similar to
;the MASK function on CDC computers.
;.b1.nf;Calling sequence:
; BITS = MASK(NBITS)
; where NBITS is integer number of bits in the mask
; and BITS and MASK are of the same type (both LOGICAL, both REAL,
; or both DOUBLE PRECISION)
;.F.NJ;Note: If NBITS is negative the mask generated is the complement
;-of that generated by MASK(ABS(NBITS))
NBITS==0
SEGMENT CODE
HELLO MASK
CLEARB T0,T1
PUSH P,T2
PUSH P,T3
SKIPN T2,@NBITS(AP)
JRST MASKOK ;IF NBITS IS ZERO
MOVM T2,T2
IDIVI T2,^D36
SOJG T2,ALLSET ;IS COUNT .GE. 72?
JUMPE T3,NOSHFT ;EVEN # WORDS?
MOVX T0,<1B0> ;SET THE FIRST BIT
MOVNI T3,(T3) ;NEGATE SHIFT COUNT FOR RIGHT SHIFT
ASH T0,1(T3) ;BUILD THE PARTIAL WORD
NOSHFT: JUMPL T2,ONEWRD ;SINGLE WORD?
CAIA
ALLSET: SETO T0,
MOVE T1,T0
SETO T0, ;AND SET ALL BITS IN THE FIRST
ONEWRD: SKIPL @NBITS(AP) ;WAS SHIFT COUNT NEGATIVE?
JRST MASKOK ;NO - DONT COMPLEMENT
SETCM T0,T0
SETCM T1,T1
MASKOK: POP P,T3 ;RESTORE WORK ACs
POP P,T2
RET
PRGEND
title CSHIFT - character circular shift SUBROUTINE or FUNCTION
subttl nh samuelson, 2641, 4/14/78
SEARCH SLAUNV
SLAPLG ;STANDARD PROLOGUE
;+.TP15.HL1 CSHIFT
;.NJ;CSHIFT is either a SUBROUTINE, or a FUNCTION.
;It does character shifting in DOUBLE PRECISION (ie: A10 FORMAT)
;such that the characters come out in normal character positions, in
;spite of the extra bit in each word.
;.B1.nf;Calling sequence:
; CALL CSHIFT(DPVAR,NUMCH,DPRES)
;or DPRES = CSHIFT(DPVAR,NUMCH)
; where DPVAR is a DOUBLE PRECISION variable in A10 format
; DPRES is the DOUBLE PRECISION result (in A10 format)
; NUMCH is the number of character positions to shift
; if NUMCH is positive, the characters are shifted
; #LEFT, END AROUND (ie: rotated).
; If NUMCH is negative, the characters are shifted
; #RIGHT, END OFF with blank fill
; on return the contents of DPVAR and NUMCH are un-changed.
;.F.NJ.b1;NOTE - If called as a FUNCTION, CSHIFT must be declared
;-DOUBLE PRECISION in the calling program.
;register assignments:
; t0&t1 = output string
; t2 = temp
; t3 = count
; t4 = current pointer to input
; p1 = initial pointer to input
; p2 = negative shift count
; p3 = byte pointer to string in t0+t1
DPVAR==0
NUMCH==1
DPRES==2
SEGMENT DATA
SAVRGS: BLOCK P3-T2+1
SEGMENT CODE
HELLO CSHIFT
MOVE T1,[T2,,SAVRGS]
BLT T1,SAVRGS+P3-T2
MOVE P3,[POINT 7,T0] ;starting byte pointer
IFN FTN77,<
LDB T1,[POINT 4,DPVAR(AP),12]
CAIE T1,15 ;DESCRIPTOR?
JRST NOTF77
TMSG <
?CSHIFT should NOT be used with FORTRAN-77 program>
HALTF%
JRST .-1
NOTF77:
>;IFN FTN77
XMOVEI P1,@DPVAR(AP) ;get address of chars
TLNE P1,-1 ;extended addressing?
TXOA P1,<61B5>
HRLI P1,(POINT 7,) ;make a byte pointer
MOVE T4,P1 ;get copy of byte pointer
SKIPGE T2,@NUMCH(AP) ;get number of characters to shift
JRST RIGHT ;negative count = shift right
IDIVI T2,^D10 ;get remainder ie: n mod 10.
JUMPE T3,NOSHFT ;zero count?
LEFT:
MOVN P2,T3 ;save negative shift count
CLEARB T0,T1 ;new words built here
ADJBP T3,T4 ;skip over first n characters
MOVE T4,T3
MOVEI T3,^D10(P2) ;get # chars remaining
CALL COPY
MOVE T4,P1 ;get byte pointer for first chars
MOVM T3,P2 ;and count
CALL COPY
JRST STORE
RIGHT:
MOVE T0,[ASCII/ /] ;blanks
MOVE T1,T0 ;in both words
MOVM T3,T2 ;get (+) shift count
CAIL T3,^D10 ;loose everything?
JRST STORE ;yes - all blanks
MOVE P2,T2 ;save neg shift count
ADJBP T3,P3 ;skip the blanks
MOVE P3,T3
MOVEI T3,^D10(P2) ;# chars remaining
CALL COPY
JRST STORE
COPY:
ILDB T2,T4 ;get a byte
IDPB T2,P3 ;store it
SOJG T3,COPY ;loop till done
RET
NOSHFT:
DMOVE T0,(P1) ;copy the input
STORE:
HLRZ T2,-1(AP) ;arg count
CAIE T2,-3 ;3 args?
JRST GOBAK ;we were called as a FUNCTION
XMOVEI T2,@DPRES(AP) ;result address
DMOVEM T0,(T2) ;STORE THE RESULT
GOBAK:
MOVE P3,[SAVRGS,,T2]
BLT P3,P3
RET
PRGEND
TITLE ECHO - TURN ECHO ON OR OFF
SUBTTL NHS, 2641, 7/26/78
SEARCH SLAUNV
SLAPLG ;STANDARD PROLOGUE
;+.TP15.HL1 Terminal control routines
;.f.nj;These FORTRAN SUBROUTINES take no arguments.
;A call to ECHO will turn on echo, a call to NOECHO will turn it off.
;A call to CTRLO will restart typeout in case the user stopped it
;-with _^O. (This is a good idea before typeing error messages).
SEGMENT CODE
HELLO ECHO
ife ftjsys,<
SETO T1,
GETLCH T1 ;GET CHARACTERISTICS OF MY TTY
TXZ T1,GL.LCP ;TURN ON ECHO
SETLCH T1
>;end ife ftjsys
ifn ftjsys,<
MOVEI T1,.PRIIN
RFMOD%
TXO T2,TT%ECO ;set the echo bit
SFMOD%
>;end ifn ftjsys
RET
HELLO NOECHO
ife ftjsys,<
SETO T1,
GETLCH T1
TXO T1,GL.LCP
SETLCH T1
>;end ife ftjsys
ifn ftjsys,<
MOVEI T1,.PRIIN
RFMOD%
TXZ T2,TT%ECO ;clear the echo bit
SFMOD%
>;end ifn ftjsys
RET
HELLO CTRLO
ife ftjsys,<
SKPINL ;CHECK FOR TTY INPUT, WAKE THE TTY
RET
>;end ife ftjsys
ifn ftjsys,<
MOVEI T1,.PRIOU
RFMOD%
TXZ T2,TT%OSP ;clear the suppress output bit
SFMOD%
>;end ifn ftjsys
RET
PRGEND
TITLE IBYTE - TO GET AN ARBITRARY BYTE FROM ANY WORD
SUBTTL NH SAMUELSON - 9/75
SEARCH SLAUNV
SLAPLG ;STANDARD PROLOGUE
;+.TP15.HL1 IBYTE
;.NJ;IBYTE is a FUNCTION which returns an arbitrary sized byte
;from any word.
;.b1.nf;Calling sequence:
; IBYTE(WORD,SIZE,LOC)
; where WORD is the word containing the desired byte
; SIZE is the (INTEGER) length of the byte
; and LOC is the (INTEGER) location of the rightmost bit
; (bits are numbered from 0 on the left to 35 on the right)
;-.b1.f.nj;IBYTE should be declared LOGICAL in the calling program.
WORD==0
SIZE==1
LOC==2
SEGMENT CODE
HELLO IBYTE
MOVEI T0,^D35 ;COMPUTE "P"
SUB T0,@LOC(AP) ;..
LSH T0,6 ;POSITION IT
ADD T0,@SIZE(AP) ;GET BYTE SIZE ("S")
LSH T0,^D24 ;BUILD BYTE POINTER
TLO T0,T1 ;INDEX BY T1
XMOVEI T1,@WORD(AP) ;GET THE ADDRESS
LDB T0,T0 ;GET THE BYTE INTO AC0 FOR RETURN
RET
PRGEND
title PUTBYT - Put any byte anywhere in any word
subttl NH Samuelson, 2644, 2/80
SEARCH SLAUNV
SLAPLG
;+.tp15.hl1 PUTBYT
;.nj;PUTBYT is a SUBROUTINE which puts an arbitrary sized byte
;into any word.
;.b1.nf;Calling sequence:
; CALL PUTBYT(WORD,SIZE,LOC,VAL)
; where WORD is the word to be modified
; SIZE is the (INTEGER) length of the byte
; LOC is the (INTEGER) location of the rightmost bit
; and VAL is the value to be stored
;- (bits are numbered from 0 on the left to 35 on the right)
WORD==0
SIZE==1
LOC==2
VAL==3
SEGMENT CODE
HELLO PUTBYT
PUSH P,T2
MOVEI T2,^D35 ;COMPUTE "P"
SUB T2,@LOC(AP) ;..
LSH T2,6 ;POSITION IT
ADD T2,@SIZE(AP) ;GET BYTE SIZE ("S")
LSH T2,^D24 ;BUILD BYTE POINTER
TLO T2,T1 ;INDEXED BY T1
XMOVEI T1,@WORD(AP) ;GET THE ADDRESS
MOVE T0,@VAL(AP) ;get the value to store
DPB T0,T2 ;store the byte
POP P,T2
RET
PRGEND
TITLE NCHAR - TO GET A ARBITRARY CHARACTER FROM A STRING
SUBTTL NH SAMUELSON, 2641, 8/78
SEARCH SLAUNV
SLAPLG ;STANDARD PROLOGUE
;+.TP15.HL1 NCHAR
;.F.NJ;NCHAR is a FUNCTION which returns the Nth character of
;an ASCII character string.
;.b1.nf;Calling sequence:
; NCHAR(STRING,NPOS)
; where STRING is a variable (or array) containing an ASCII string
; and NPOS is the position of the character desired
; (starting with position 1 at the left)
;.b1.f.nj;NCHAR should be decalred INTEGER or LOGICAL in
;-the calling program.
STRING==0
NPOS==1
CHAR==2
SEGMENT CODE
HELLO NCHAR
CALL BLDPTR ;BUILD BYTE POINTER
LDB T0,T0 ;GET THE CHARACTER
RET
;+.TP15.HL1 PUTCHR
;.F.NJ;PUTCHR is a SUBROUTINE which replaces a character in
;an ASCII string.
;.b1.nf;Calling sequence:
; CALL PUTCHR(STRING,NPOS,CHAR)
; where STRING is a variable (or array) containing an ASCII STRING
; NPOS is the position of the character to be replaced
; (starting with position 1 at the left)
; and CHAR is the character to insert into the string right justified
; (as is the character returned by NCHAR)
;note: to take a character from one string and put it into another
;you can call PUTCHR and NCHAR as follows:
;- CALL PUTCHR(STR1,NPOS1,NCHAR(STR2,NPOS2))
HELLO PUTCHR
CALL BLDPTR ;BUILD BYTE POINTER
MOVE T1,@CHAR(AP) ;GET THE CHARACTER
DPB T1,T0 ;STORE IT
RET
BLDPTR:
IFN FTN77,<
LDB T0,[POINT 4,STRING(AP),12] ;GET ARG TYPE
CAIN T0,15 ;DESCRIPTOR?
JRST [TMSG <
?Call to NCHAR or PUTCHR passed by DESCRIPTOR - use FORTRAN SUBSTRING instead!>
HALTF%
CLEAR T0,
RET]
>;IFN FTN77
MOVE T0,@NPOS(AP) ;GET POSITION
SOJL T0,BADCNT ;BAD COUNT
IDIVI T0,5 ;CONVERT TO WORDS
PUSH P,T0 ;save word offset
XMOVEI T0,@STRING(AP) ;GET ADDRESS OF DESIRED WORD
TLNE T0,-1
TDOA T0,[62B5
63B5
64B5
65B5
66B5](T1)
HLL T0,[POINT 7,0,6
POINT 7,0,13
POINT 7,0,20
POINT 7,0,27
POINT 7,0,34](T1) ;MAKE BYTE POINTER
POP P,T1
ADDI T0,(T1) ;adjust by word offset
RET
BADCNT: TMSG <
?Character position not positive in call to PUTCHR or NCHAR
>
ife ftjsys,<MONRT.>
ifn ftjsys,<HALTF%>
CLEAR T0, ;IN CASE OF CONTINUE
JRST BLDPTR+2
PRGEND
title MEMORY - dynamic memory allocation for FORTRAN
subttl N Samuelson, 2641, 4/78
SEARCH SLAUNV
SLAPLG ;STANDARD PROLOGUE
;+.TP15.HL1 DYNAMIC MEMORY MANAGEMENT
;.NJ;Two routines are provided to interface with the memory allocation
;routines in FOROTS (the fortran run-time library). One to allocate
;core (MORCOR) and the other to return it (RELCOR).
;.hl2 MORCOR
;MORCOR is a FORTRAN FUNCTION which requests core from FOROTS
;and returns the OFFSET to be used to make future references to
;the allocated memory.
;.B1.nf;Calling sequence:
; OFFSET = MORCOR(ARAY,LENGTH)
;.B1.F.NJ;MORCOR should be declared LOGICAL or INTEGER in the calling
;program. The newly allocated memory will be zeroed by FOROTS.
;.b1;To access the allocated memory use the following:
;-.I6;ARAY(OFFSET+I)
ARAY==0
LENGTH==1
OFFSET==1
SEGMENT DATA
-1,,0 ;arg list for alcor.
GETARG: BLOCK 1
-2,,0 ;arg list for decor.
RELARG: 2B12!RELADR
RELADR: BLOCK 1 ;address of block to be returned
SEGMENT CODE
HELLO MORCOR
SKIPG @LENGTH(AP) ;is request .gt. 0?
JRST BADREQ ;bad request
HRREI T1,@ARAY(AP) ;get address of array
MOVEM T1,RELADR ;save address
MOVE T1,1(AP) ;get length pointer from arg list
XMOVEI AP,GETARG ;setup new pointer
MOVEM T1,0(AP) ;store the length pointer
CALL ALCOR.## ;get some core
JUMPL T0,NOCORE ;cant get it?
SUB T0,RELADR ;compute offset
RET
BADREQ: TMSG <
?less than one word of core requested in MORCOR>
JRST .EXIT
NOCORE: TMSG <
?CORE request failed in MORCOR>
.EXIT:
ife ftjsys,<MONRT.> ;die
ifn ftjsys,<HALTF%>
CLEAR T0, ;in case of continue
RET
;+.HL2 RELCOR
;RELCOR is a FORTRAN SUBROUTINE to release core allocated by MORCOR.
;.b1.nf;Calling sequence:
; CALL RELCOR(ARAY,OFFSET)
;where OFFSET is the value returned by MORCOR
;NOTE: RELCOR returns the memory to FOROTS, but FOROTS does not,
;at present, release the core to the system.
;-It does, however, re-use it if possible on future calls to MORCOR.
HELLO RELCOR
HRREI T1,@ARAY(AP) ;get array address
ADD T1,@OFFSET(AP) ;ADDRESS OF CORE TO GIVE BACK
MOVEM T1,RELADR ;save the address
MOVEI AP,RELARG ;new arg pointer
JRST DECOR.## ;give core back to FOROTS
PRGEND
Title EXTADR - get extended memory for FORTRAN.
Subttl Norm Samuelson, 2644, 8/82
SEARCH SLAUNV
SLAPLG
.REQUES SYS:MACREL
;+.hl1 EXTADR
;Aquire extended memory for use by FORTRAN (v7)
;.b1;This routine allocates very large arrays for use in FORTRAN
;programs. The memory can be treated in FORTRAN like a very large
;array (dimensioned very small in source). This is acomplished
;by returning IOFSET, which can be used the FORTRAN as follows:
;.NF.b1.lm7;COMMON /BIGGER/ BIG(1)
;INTEGER IOFSET
;#...
;.I-6;C allocate ISIZE words, return IOFSET
;CALL EXTADR (BIG, ISIZE, IOFSET)
;#...
;.I-6;C use that array as follows:
;DO 10 I=1,ISIZE
;BIG (IOFSET+I) = I
;.I-6;10 CONTINUE
;.F.NJ.B1.lm0;The program must be run in a non-zero section. To make
;that easier you should do the following:
;.ls.le;LOAD the program as usual
;.le;SAVE it
;.le;GET progname/USE-SECTION:1
;.le;SAVE progname
;-.els
BIG==0
ISIZE==1
IOFSET==2
SEGMENT DATA
memend: block 1 ;end of memory (0 if not initialized)
avlsec: block 1
SEGMENT CODE
hello extadr
skipn memend ;initialized yet?
call init ;no - setup map
hrrei t2,@BIG(ap) ;get LOCAL address of IBIG
movn t2,t2
add t2,memend ;compute offset
movem t2,@IOFSET(ap) ;return it to user
move t2,@ISIZE(ap)
addb t2,memend ;new end
sos t2
hlrz p2,t1 ;get starting section
hlrz p3,t2 ; and ending
movei p4,(p2)
subi p4,1(p3) ;last+1-first = -#sections
hrlzi p4,(p4)
hrri p4,(p2) ;make aobjn counter
extm.1: movei t1,(p4) ;get section to be checked
hrli t1,.fhslf
rsmap%
jumpg t1,extm.5 ;not available (mapped by something else)
jumpe t1,extm.2 ;private section
clear t1,
movei t2,(p4) ;section to create
hrli t2,.fhslf
movx t3,<sm%wr!1> ;one writable section
smap%
erjmp jshlt0## ;die
extm.2: aobjn p4,extm.1
ret ;memory is allocated.
extm.5: tmsg <
?Found a section with strange mapping where free memory was expected.>
haltf%
jrst die
init: clear t1,
xhlli t1,.
jumpe t1,s0fail
add t1,[1,,0] ;start at first section above code
movem t1,memend
ret
s0fail: tmsg <
?The EXTADR routine cannot function when the program is run in
section 0. Type continue for more info.>
haltf%
tmsg <
EXTADR uses extended addressing, which is not available to a program
running in section 0. Please do the following:
1) LOAD your program as usual
2) SAVE it as usual
3) RUN progname/USE-SECTION:1
or
3) GET progname/USE-SECTION:1
4) SAVE it again
5) RUN it as usual>
die: haltf%
tmsg <?Cant continue>
jrst die
prgend
TITLE TTYINT - enable terminal interrupts.
subttl N Samuelson, 2644, 4/82
SEARCH SLAUNV
SLAPLG
.REQUES SYS:MACREL
F.GPSI==17
SEGMENT DATA
STAT.: BLOCK 1
ACTLOC: BLOCK 1
-6,,0
ARGLST: ifiw [F.GPSI]
ifiw [ASCIZ/FMC/]
ifiw STAT.
ifiw CHAN
ifiw [3] ;interrupt level - use lowest
ifiw ACTLOC
;+.tp15.hl1 TTYINT
;TTYINT is a FORTRAN (only) SUBROUTINE which allow a fortran program
;to use the software interrupt system to signal when the user has
;typed a particular control character.
;.b1;Calling sequence:
;.i8;CALL TTYINT (NUM,FLAG)
;. ;where NUM is the terminal interrupt code (see monitor calls
;manual section 2.6.6 table 2-13 pg 2-58) [1=^A, 2=^B, 25=^Y, etc]
;. ;#and FLAG is a boolean variable to be set to true when
;-the interrupt occurs.
;
;NOTE *** Change in specs, the following has been removed...(repeat 0)
;If the variable is already true, the interrupt
;routine will type an error message and exit, allowing CONTINUE.
;This is an escape mechanism in case the user traps ^C and gets into
;-a loop not looking at the flag.
NUM==0
FLAG==1
CHAN: BLOCK 1
NUM.: BLOCK 1
FLAGS.: BLOCK ^D36
SAVEAP: BLOCK 1
SEGMENT CODE
HELLO TTYINT
MOVEM AP,SAVEAP
MOVE T1,@NUM(AP)
MOVEM T1,NUM.
SKIPE FLAGS.(T1)
JRST [TMSG <
?Overriding previously set interrrupt request in TTYINT
type CONTINUE if you wish to proceed>
HALTF%
MOVE T1,NUM.
JRST .+1]
XMOVEI T2,@FLAG(AP)
MOVEM T2,FLAGS.(T1)
SETOM CHAN
XMOVEI T2,ACTION(T1)
MOVEM T2,ACTLOC
SETZM STAT.
PUSH P,AP
XMOVEI AP,ARGLST
CALL FUNCT.## ;GET THE CHANNEL ASSIGNED
POP P,AP
SKIPE STAT.
JRST [TMSG <?Error assigning channel for interrupts>
HALTF%
JRST .+1]
MOVN T1,CHAN
MOVX T2,<1B0>
LSH T2,(T1)
MOVEI T1,.FHSLF
AIC% ;ENABLE THE CHANNEL
EIR% ;ENABLE THE INTERRUPT SYSTEM
HRLZ T1,NUM. ;GET TERMINAL CODE
HRR T1,CHAN
ATI%
ERJMP JSHLT0##
RET
;action routines for interrupt level.
ACTION:
repeat ^d36,<PUSHJ P,TTINT>
TTINT: EXCH T1,(P) ;get PC of PUSHJ +1
SUBI T1,ACTION+1 ;GET TERMINAL CODE
TLZ T1,-1 ;Make it a local index
repeat 0,<
SKIPE @FLAGS.(T1) ;ALREADY SET?
JRST [PUSH P,T1
TMSG <
?Interrupt flag is set already. Type CONTINUE to proceed...>
POP P,T1
HALTF%
JRST .+1]
>;end repeat 0
SETOM @FLAGS.(T1)
POP P,T1
DEBRK%
ERJMP JSHLT0##
PRGEND
TITLE ZERO - zero a block of memory quickly
SUBTTL NH SAMUELSON, 2641, 10/78
SEARCH SLAUNV
SLAPLG ;STANDARD PROLOGUE
;+.TP15.HL1 ZERO
;.F.NJ;ZERO is a group of FORTRAN SUBROUTINEs which clear memory.
;The entry point names were chosen for an existing application (SPICE2)
;They are related to IBM terminology (ie: REAL*4, REAL*8, etc).
;.B1.nf;Calling sequence:
; CALL ZERO4(A,N)
; or CALL ZERO8(A,N)
; or CALL ZERO16(A,N)
; where A is the start of the block to zero
; and N is the number of elements to zero.
; (ie: elements are words(ZERO4), double-words(ZERO8),
; or quad-words(ZERO16))
;.b1.f.nj;The memory is cleared with Block Transfer instruction,
;-which is very efficient.
A==0
N==1
SEGMENT CODE
HELLO ZERO16
MOVEI T1,2 ;QUADRUPLE WORDS
JRST ZERO
HELLO ZERO8
MOVEI T1,1 ;DOUBLE WORDS
JRST ZERO
HELLO ZERO4
CLEAR T1, ;NO SHIFT
ZERO: SKIPG T2,@N(AP) ;GET # WORDS TO CLEAR
RET
LSH T2,(T1) ;ADJUST FOR ELEMENT SIZE
XMOVEI T1,@A(AP) ;GET START ADDRESS
SETZM (T1) ;ZERO THE FIRST WORD
IFE FTJSYS,<
SOJLE T2,RTN ;# WORDS LEFT TO CLEAR
ADDI T2,(T1) ; LAST ADDRESS TO CLEAR
HRLI T1,(T1) ; FWA,,FWA
AOS T1 ; FWA,,FWA+1
BLT T1,(T2) ;CLEAR THE REST
>;IFE FTJSYS
IFN FTJSYS,<
MOVE T0,T2
SOJLE T0,RTN ;# WORDS LEFT TO CLEAR
XMOVEI T2,1(T1)
XBLT T0,
>;IFN FTJSYS
RTN: RET
PRGEND
TITLE COPY - COPY A BLOCK OF MEMORY
SUBTTL NH SAMUELSON, 2641, 10/78
SEARCH SLAUNV
SLAPLG ;STANDARD PROLOGUE
;+.TP15.HL1 COPY
;.F.NJ;COPY is a group of FORTRAN SUBROUTINEs which copy blocks of memory.
;The entry point names were chosen for an existing application (SPICE2).
;They are related to IBM terminology (ie: REAL*4, REAL*8, etc).
;.b1.nf;Calling sequence:
; CALL COPY4(A,B,N)
; or CALL COPY8(A,B,N)
; or CALL COPY16(A,B,N)
; where A is the start of the FROM block
; B is the start of the TO block
; and N is the number of elements to copy.
; (ie: elements are words(ZERO4), double-words(ZERO8),
; or quad-words(ZERO16))
;.f.nj.b1;The Block Transfer instruction is used for fast block
;copying when possible. That is not possible if the block is
;being moved up in memory and the blocks overlap, in that case
;it is necessary to use a loop to transfer one word at a time.
;-The loop used is as fast as possible under the circumstances.
A==0
B==1
N==2
SEGMENT CODE
HELLO COPY16
MOVEI T2,2
JRST COPY
HELLO COPY8
MOVEI T2,1
JRST COPY
HELLO COPY4
CLEAR T2,
COPY: SKIPG T3,@N(AP)
RET ;dont copy anything
LSH T3,(T2) ;ADJUST FOR ELEMENT LENGTH
XMOVEI T1,@A(AP) ;FROM ADDRESS
XMOVEI T2,@B(AP) ;TO ADDRESS
IFN FTJSYS,<
MOVE T0,T3
CAMLE T1,T2 ;MOVING DOWN?
JRST MOVEOK ;YES - ALWAYS SAFE
ADD T1,T0
ADD T2,T0
MOVN T0,T0 ;-N = blt UP
MOVEOK: XBLT T0,
RET
>;IFN FTJSYS
IFE FTJSYS,<
SOJLE T3,CPY1WD ;WORD COUNT MINUS ONE
CAILE T1,(T2) ;MOVING DOWN?
JRST MOVEOK ;YES - ALWAYS SAFE
MOVEI T0,(T2)
SUBI T0,(T1)
CAIG T0,(T3) ;OR UP FAR ENOUGH
JRST MOVEUP ;NO - TOO BAD
MOVEOK: HRLI T2,(T1) ;PREPARE FOR BLT
ADDI T3,(T2) ;END ADDRESS
BLT T2,(T3)
RET
CPY1WD: MOVE T1,@A(AP) ;GET THE ONE WORD
MOVEM T1,@B(AP) ;STORE IT
RTN: RET
;THE FOLLOWING IS SOME OF THE MOST OBSCURE CODE I EVER HOPE TO WRITE
;IT IS TAKEN FROM THE HARDWARE REFERENCE MANUAL, IN A MARGINAL NOTE
;RELATED TO THE POP INSTRUCTION.
;A TWO INSTRUCTION LOOP, FOLLOWED BY A RETURN, IS LOADED INTO AC'S
;P1 THRU P3, THEN WE JUMP INTO THE AC'S TO PERFORM THIS MAGIC.
MOVEUP: MOVSI P1,(POP T1,0(T1)) ;BUILD A POP INSTR. IN P1
ADD P1,T0 ;IE: POP T1,B-A(T1)
HRLI T1,400000(T3) ;SETUP T1 AS THE STACK POINTER
ADDI T1,(T3) ;IE: 400000+N-1,,B+N-1
MOVE P2,[JUMPL T1,P1] ;PUT JUMPL INSTR. IN P2
MOVE P3,RTN ;AND RETURN INSTR. IN P3
JRST P1 ;GOOD LUCK!
>;IFE FTJSYS
PRGEND
TITLE TTSYNC GET IN SYNC WITH TTY OUTPUT
SUBTTL NH SAMUELSON, 2641, 5/16/79
SEARCH SLAUNV
SLAPLG ;STANDARD PROLOGUE
;+.TP15.HL1 TTSYNC
;TTSYNC is a FORTRAN SUBROUTINE which allows a program to get back
;into sync with terminal output. It waits for the output buffer to
;become empty, then turns off the effect of any control-O which might
;have been typed by the user.
;It can also wait a specified period after output has stopped,
;to allow the terminal to settle down (eg: for TEKTRONIX graphics
;terminals to clear the screen).
;.b1;Calling sequence:
;.i8;CALL TTSYNC(ITIME)
;-.i2;where ITIME is the number of milliseconds to wait after output stops.
SLPTIM==^D100 ;100 MILLISECONDS PER HIBER WAITING FOR OUTPUT DONE
ITIM==0 ;ONLY ARG - SLEEP TIME AFTER OUTPUT DONE
SEGMENT CODE
HELLO TTSYNC
ife ftjsys,<
SETO T3,
TRMNO. T3, ;GET OUR TTY #
RET ;NO TTY - DONT WAIT
MOVEI T2,.TOSOP ;FUNCTION=SKIP IF DOING OUTPUT
CHKBFR: MOVE T1,[2,,T2]
TRMOP. T1,
JRST NOTBSY ;BUFFER EMPTY NOW
MOVEI T1,SLPTIM ;SET SLEEP TIME
HIBER T1, ;SLEEP
SLEEP T1, ;REALLY SLEEP
JRST CHKBFR ;THEN TRY AGAIN
NOTBSY: SKPINL ;CHECK FOR INPUT TO WAKE TTY
JFCL
SKIPLE T1,@ITIM(AP) ;EXTRA SLEEP TIME
HIBER T1,
JFCL
>;end ife ftjsys
ifn ftjsys,<
MOVEI T1,.PRIOU
DOBE% ;dismiss until output buffer empty
SKIPLE T1,@ITIM(AP) ;time to sleep
DISMS%
>;end ifn ftjsys
RET
PRGEND
TITLE FORKS - SUBROUTINES TO CONTROL FORKS
SUBTTL NH Samuelson, 2641, 10/79
SEARCH SLAUNV
SLAPLG ;PROLOGUE
ife ftjsys,<
printx %You cant have forks on a DEC-10
>
ifn ftjsys,<
.REQUEST SYS:MACREL
;+.HL1 FORK HANDLING ROUTINES
;.F.NJ;FORKS is a collection of FORTRAN (or PASCAL) callable routines
;to manipulate forks. Facilities are provided to create forks, destroy forks,
;load programs into forks, start forks, freeze forks, resume forks, and
;wait on forks.
;.b1;All fork handling routines require a 'fork handle' to distinguish
;between possible multiple forks. When a fork is created
;a handle is returned, that same handle must be used in all future
;references to that fork
;.hl2 FRKCRE - Create a fork
;.nf.b1;Calling sequence:
; CALL FRKCRE(BITS,HANDLE)
; where BITS is a logical mask to control the forks address space and capabilities (Normally ZERO)
;- and HANDLE (on return) is the new fork handle (INTEGER)
SEGMENT CODE
HELLO FRKCRE
SKIPN T1,@0(AP) ;GET THE BITS
TXO T1,CR%CAP ;GIVE HIM OUR CAPABILITIES
CFORK%
JSERR
MOVEM T1,@1(AP) ;RETURN THE FORK HANDLE
RET
;+.HL2 FRKKIL - Kill a fork
;.b1.nf;Calling sequence:
;- CALL FRKKIL(HANDLE)
HELLO FRKKIL
MOVE T1,@0(AP) ;GET HANDLE
KFORK% ;KILL IT
ERJMP JSERR0##
RET
;+.HL2 FRKHLT - Halt a fork
;.b1.nf;Calling sequence:
;- CALL FRKHLT(HANDLE)
HELLO FRKHLT
MOVE T1,@0(AP)
HFORK%
ERJMP JSERR0##
RET
;+.HL2 FRKWAI - Wait for a fork to exit
;.b1.nf;Calling sequence:
;- CALL FRKWAI(HANDLE)
HELLO FRKWAI
MOVE T1,@0(AP)
WFORK%
ERJMP JSERR0##
MOVE T1,@0(AP)
RFSTS%
ERJMP JSERR0##
LDB T1,[POINT 17,T1,17] ;GET RF%STS
CAIN T1,.RFHLT ;DID IT HALT VOLUNTARILY?
RET ;YES
TMSG <?
?Error in fork termination - >
MOVEI T1,.PRIOU
HRLO T2,@0(AP) ;GET HANDLE AGAIN
CLEAR T3,
ERSTR%
ERJMP JSERR0##
ERJMP JSERR0##
RET
;+.HL2 FRKFRZ - Freeze (suspend) a fork
;.b1.nf;Calling sequence:
;- CALL FRKFRZ(HANDLE)
HELLO FRKFRZ
MOVE T1,@0(AP)
FFORK%
ERJMP JSERR0##
RET
;+.HL2 FRKRES - Resume a (suspended) fork
;.b1.nf;Calling sequence:
;- CALL FRKRES(HANDLE)
HELLO FRKRES
MOVE T1,@0(AP)
RFORK%
ERJMP JSERR0##
RET
;+.HL2 FRKSTA - Start a fork
;.b1.nf;Calling sequence:
; CALL FRKSTA(HANDLE)
;Optional calling sequence:
; CALL FRKSTA(HANDLE,OFFSET)
;-where OFFSET is the offset into the entry vector to the desired starting address.
HELLO FRKSTA
MOVE T1,@0(AP)
HLRE T2,-1(AP) ;get arg count
MOVM T2,T2 ;make it positive
CAIL T2,2 ;are there 2 args?
SKIPA T2,@1(AP) ;yes, get the second arg
CLEAR T2, ;no, normal starting address
SFRKV%
ERJMP JSERR0##
RET
;+.HL2 FRKGET - Get (load) an .EXE file into a fork
;.b1.nf;Calling sequence:
; CALL FRKGET(HANDLE,JFN)
;- where JFN is a 'Job File Number' for the file to be loaded (obtained from GETJFN)
HELLO FRKGET
MOVS T1,@0(AP)
HRR T1,@1(AP)
CLEAR T2,
GET%
ERJMP JSERR0##
RET
;+.hl2 FRKSAC - Set fork ACs. This should rarely be used, but
;is necessary when running programs which expect parameters to be
;set in the accumulators (ACs). (EDIT is such a program).
;.b1.nf;Calling sequence:
; CALL FRKSAC(HANDLE,ACBLOK)
;- where ACBLOK is an array of 16 words (INTEGER)
HELLO FRKSAC
MOVE T1,@0(AP) ; GET FORK HANDLE
MOVEI T2,@1(AP) ; AND ADDRESS OF ACBLOK
SFACS%
ERJMP JSERR0##
RET
;+.HL2 GETJFN
;The GETJFN routine returns a number (called a JFN) which is used by
;the operating system for all calls related to files. It is included in
;the FORKS package because a JFN is required in the FRKGET routine to
;specify the file to be loaded.
;.nf.b1;Calling sequence:
; CALL GETJFN(FILNAM,JFN)
; where FILNAM is an array or literal containing the name of the file desired
;- and JFN is (on return) the JFN for the desired file
HELLO GETJFN
XMOVEI T2,@0(AP)
TLNE T2,-1
TXOA T2,<61B5>
HRLI T2,(POINT 7,0)
IFN FTN77,<
LDB T1,[POINT 4,0(AP),12] ;GET ARG TYPE
CAIN T1,15 ;DESCRIPTOR?
MOVE T2,@0(AP) ;YES, GET THE POINTER
>;IFN FTN77
MOVX T1,<GJ%OLD!GJ%SHT> ;SHORT FORM, OLD FILE ONLY
GTJFN%
ERJMP [SETZM @1(AP) ;IN CASE OF ERROR RETURN JFN=0
CALLRET JSERR0##]
MOVEM T1,@1(AP) ;RETURN THE JFN
RET
>;ifn ftjsys
PRGEND
TITLE EXIT0 - SETUP FOR QUIET EXIT FROM FORTRAN
SEARCH SLAUNV
SLAPLG
;+.HL1 EXIT0 routine
;.f.nj;The routine EXIT0 can be called from FORTRAN ONLY!
;Its purpose is to signal FOROTS that, on exit, the CPU time and ELAPSED
;time message are NOT to be typed out. It does NOT exit, it merely sets
;that flag.
;.b1.nf;Calling sequence: fortran:
;- CALL EXIT0
SEGMENT CODE
HELLO EXIT0
MOVEI T0,12 ;ARGUMENT TO FOROP.
CALLRET FOROP.## ;IN FOROTS
PRGEND
TITLE DOJSYS - PASCAL, FORTRAN, AND COBOL CALLABLE JSYS DOER
SUBTTL NH SAMUELSON, 2641, 10/3/79
SEARCH SLAUNV
SLAPLG ;STANDARD PROLOGUE
.REQUEST SYS:MACREL
;+.HL1 DOJSYS routine
;.f.nj;The routine DOJSYS can be called from either FORTRAN or COBOL
;to perform any JSYS monitor call in TOPS-20.
;.b1.nf;Calling sequence: fortran:
; CALL DOJSYS(NUMBER,ARG1,ARG2,...,ARGN [,$LABEL])
;PASCAL:
;Define DOJSYS as:
; PROCEDURE DOJSYS(JSYS_NUM: INTEGER; VAR AC1,AC2,AC3,AC4: INTEGER); FORTRAN;
;Call it with:
; DOJSYS(NUMBER, ARG1, ARG2, ARG3, ARG4)
;COBOL:
; ENTER MACRO DOJSYS USING NUMBER, ARG1, ARG2,...,ARGN [,PROC-NAME].
; where NUMBER is the JSYS number to be performed
; ARG1 thru ARGN are the arguments for the JSYS
; $LABEL or PROC-NAME is the return address in case of error
;-.f.nj;Note: In PASCAL the error-return address cannot be used.
SEGMENT CODE
HELLO DOJSYS
HLL AP,-1(AP) ;form aobjn word for rest of arglist
MOVE 15,@0(AP) ;get JSYS number
HRLI 15,(JSYS) ;make a JSYS
CLEARB 14,13 ;point at first AC
CLEARB 1,2 ;CLEAR THE AC'S IN CASE NO ARGS
CLEARB 3,4
AOBJP AP,DOJ2 ;step to next arg
DOJ1: LDB 13,[POINT 4,0(AP),12] ;get type of next arg
CAIN 13,7 ;label?
JRST [XMOVEI 13,@0(AP) ;get address of error return
JRST DOJ2] ;and assume we are at the end of the list...
MOVE 13,@0(AP) ;get next arg
AOJ 14, ;point to next AC
MOVEM 13,(14) ;store in the AC
AOBJN AP,DOJ1 ;do all the args
CLEAR 13, ;no error return
DOJ2: XCT 15 ;do the jsys
ERJMP DOJ4 ;error return 1
ERJMP DOJ4 ;error return 2
DOJ3:
IFN FTN77,<
LDB 13,[POINT 4,-1(AP),12] ;get arg type
CAIN 13,15 ;pointer?
JRST DOJ6 ;yes, do NOT replace it
>;IFN FTN77
MOVE 13,(14) ;get an arg back
MOVEM 13,@-1(AP) ;store for user
DOJ6: SUB AP,[1,,1] ;point to previous
SOJG 14,DOJ3 ;store all args away
RET
DOJ4: JUMPE 13,DOJ5 ;did user give error label?
MOVEM 13,(P) ;yes - fixup stack
JRST DOJ3 ;and continue
DOJ5: JSHLT ;type error message and die
prgend
Title FLT11 - convert pdp10 real to pdp11 real
subttl NH Samuelson, 2641, 1/80
SEARCH SLAUNV
SLAPLG
;+.tp15.hl1 DATA conversion routines
;.f.nj;This is a collection of SUBROUTINEs to convert PDP-10 floating
;point numbers to PDP-11 floating point and vice-versa.
;.hl2 F3632 - convert 36bit floating poing to 32-bit
;.nf.b1;Calling sequence:
; CALL F3632(FIN,FOUT,NUM)
; where FIN is the input array of PDP-10 36bit real numbers
; FOUT is the output array of PDP-11 32 bit numbers
;- and NUM is the length of each array
FIN==0
FOUT==1
NUM==2
SEGMENT CODE
byte1: point 8,t1,16
byte2: point 8,t1,7
byte3: point 8,t1,32
byte4: point 8,t1,24
expofs==0 ;difference in exponents between -10 and -11
HELLO F3632
XMOVEI P1,@FIN(AP) ;address of input array
XMOVEI P2,@FOUT(AP) ;address of output array
TLNE P2,-1
TXOA P2,<54B5>
HRLI P2,(POINT 8,0) ;make a byte pointer
SKIPA P3,@NUM(AP) ;number of elements
GO.1: AOS P1 ;advance input pointer
SKIPL T1,(P1) ;get next number
JRST POS.1 ;jump if positive
MOVN T1,T1 ;convert to sign/magnitude
TLO T1,(T1) ; ...
POS.1:
FSC T1,EXPOFS ;normalize and correct exp.
LDB T2,BYTE1 ;get the first byte
TLNN T1,(1B8) ;even exponent?
TRZ T2,200 ;yes - clear the low bit of the exp.
IDPB T2,P2 ;store it
LDB T2,BYTE2
IDPB T2,P2
LDB T2,BYTE3
IDPB T2,P2
LDB T2,BYTE4 ;get the last byte
IDPB T2,P2
SOJG P3,GO.1 ;loop till done
RET
;+.hl2 F3236 - convert 32bit to 36bit
;.nf.b1;Calling sequence:
; CALL F3236(FIN,FOUT,NUM)
; where FIN is the input array of PDP-11 32bit real numbers
; FOUT is the output array of PDP-10 36 bit numbers
;- and NUM is the length of each array
HELLO F3236
XMOVEI P1,@FIN(AP) ;address of input array
TLNE P1,-1
TXOA P1,<54B5>
HRLI P1,(POINT 8,0) ;make a byte pointer
XMOVEI P2,@FOUT(AP) ;address of output array
SKIPA P3,@NUM(AP) ;number of elements
GO.2: AOS P2 ;advance output pointer
CLEAR T1,
ILDB T2,P1 ;get first byte
TROE T2,200 ;check for odd exponent
TLO T1,(1B8) ; ...
DPB T2,BYTE1
ILDB T2,P1 ;get next byte
DPB T2,BYTE2
ILDB T2,P1
DPB T2,BYTE3
ILDB T2,P1 ;get the last byte
DPB T2,BYTE4
TLZE T1,(1B0) ;convert sign/mag to twos comp.
MOVN T1,T1
FSC T1,-EXPOFS ;correct the exponent
MOVEM T1,(P2) ;store the result
SOJG P3,GO.2
RET
prgend
title USRNAM - return NAME of user
subttl NH Samuelson, 2644, 3/8/82
SEARCH SLAUNV
SLAPLG
.REQUEST SYS:MACREL
;+.tp15.hl1 USRNAM - return NAME of user
;.f.nj;The SUBROUTINE USRNAM returns the name of the user who is
;running the program. The username in TOPS-20 is up to 39 Characters,
;so this routine returns 8 words (40 characters) with the user name
;left justified and filled with trailing blanks.
;.nf.b1;Calling sequence:
; CALL USRNAM (NAME)
;- where NAME is an array 8 words long (integer or real)
NAME==0
SEGMENT DATA
NAMPTR: BLOCK 2 ;byte pointer and count for NAME
SEGMENT CODE
HELLO USRNAM
IFN FTN77,<
LDB T2,[POINT 4,NAME(AP),12] ;GET ARG TYPE
CAIE T2,15 ;descriptor?
JRST NOTF77
DMOVE T2,@NAME(AP) ;yes
JRST ISF77
>;IFN FTN77
NOTF77: XMOVEI T2,@NAME(AP)
TLNE T2,-1
TXOA T2,<61B5>
HRLI T2,(POINT 7,0)
MOVEI T3,^D40
ISF77: DMOVEM T2,NAMPTR
MOVEI T1,.CHSPC
IDPB T1,T2
SOJG T3,.-1
SETO T1, ;this job
HRROI T2,T4 ;one word, returned in t4
MOVEI T3,.JIUNO ;get user number
GETJI%
JSHLT
MOVE T1,NAMPTR
MOVE T2,T4
DIRST%
JSHLT
MOVEI T2,.CHSPC ;turn trailing nul to blank
IDPB T2,T1
RET
prgend
title RUNTIM - return PROCESS runtime.
subttl NH Samuelson, 2644, 2/4/80
SEARCH SLAUNV
SLAPLG
;+.tp15.hl1 RUNTIME - return PROCESS runtime
;.f.nj;The SUBROUTINE RUNTIME returns the runtime used by this process
;(not by the JOB) in milliseconds.
;.nf.b1;Calling sequence:
; CALL RUNTIM(ITIME)
;- where ITIME is an INTEGER
ITIM==0
SEGMENT CODE
HELLO RUNTIM
MOVEI T1,.FHSLF
RUNTM%
MOVEM T1,@ITIM(AP)
RET
prgend
title GETERR - return last JSYS error.
subttl Frank Wancho, 01/22/86
SEARCH SLAUNV
SLAPLG
;+.tp15.hl1 GETERR - return last JSYS error
;.f.nj;The SUBROUTINE GETERR returns the last JSYS error
;as reported by the GETER% JSYS.
;.nf.b1;Calling sequence:
; CALL GETERR(IERROR)
;- where IERROR is an INTEGER
IERR==0
SEGMENT CODE
HELLO GETERR
MOVEI T1,.FHSLF
GETER%
HRRZ T1,T2
MOVEM T1,@IERR(AP)
RET
prgend
Title LOCF - return the address of an argument
Subttl NH Samuelson, 2644, 2/80
SEARCH SLAUNV
SLAPLG
;+.TP15.HL1 LOCF
;.F.NJ;LOCF is a FUNCTION which returns the address of the argument
;.b1.nf;Calling sequence:
; LOCF(ARG)
;- where ARG is ANY argument of ANY type, including a literal
ARG==0
SEGMENT CODE
HELLO LOCF
XMOVEI T0,@ARG(AP) ;GET THE ADDRESS
RET ;RETURN IT TO THE USER
HELLO LOCR
HRREI T0,@ARG(AP) ;GET LOCAL RELATIVE ADDRESS
RET
prgend
TITLE NXTJOB FORTRAN CALLABLE ROUTINE TO START ANOTHER JOB
SUBTTL NH Samuelson, 2644, 2/13/80
SEARCH SLAUNV
SLAPLG ;STANDARD PROLOGUE
;+.TP15.HL1 NXTJOB
;.f.nj;NXTJOB is a FORTRAN SUBROUTINE which will never return.
;It is equivalent to giving a RUN command at monitor level.
;It will cause the monitor to replace the current program with
;a program which is in an executable core image file (.EXE).
;.b1.nf;Calling sequence:
; CALL NXTJOB(JFN)
; where JFN is a TOPS-20 JFN for the file (see GETJFN routine)
;Alternate calling sequence (macro)
; MOVE T1,JFN
; JRST NXTJB1
;.NOTE WARNING
;Any files which are open for output should be closed before NXTJOB
;is called, or they will never be closed.
;-.end note
JFN==0
SEGMENT CODE
entry nxtjb1
HELLO NXTJOB
MOVE T1,@JFN(AP) ; GET THE JFN
NXTJB1: HRRM T1,ACCODE
MOVSI 17,ACCODE
BLT 17,ACEND
JRST ACGO
ACCODE:
PHASE 0 ; BUILD CODE FOR THE AC'S
.FHSLF,,0 ; JFN WILL GO IN RIGHT HALF
-1
.FHSLF,,0
1B0!1000
ACGO: PMAP% ; DELETE ALL CORE
MOVE 1,0 ; GET .FHSLF,,JFN
CLEAR 2,
GET% ; GET THE .EXE FILE
RESET% ; reset I/O
MOVEI 1,.FHSLF
ACEND: SFRKV%
prgend
title EXECDO - run the EXEC in a sub-process to TAKE a one-line command.
subttl Norm Samuelson, 2644, 6/25/82
SEARCH SLAUNV
SLAPLG
.REQUES SYS:MACREL
nd ftshow,0 ;non-zero to show each command on tty
;+.hl1 EXECDO
;.f.nj;The purpose of this routine is to make it easy for a high level language
;programmer to execute EXEC commands easily. It is NOT fool-proof.
;It takes one ASCIZ string as input, writes it to a temporary file,
;followed by <CRLF>POP<CRLF>. More complex commands can be handled
;by creating a command file and using the TAKE command to execute that file.
;.b1;Warning: DO commands will NOT work!
;.b1;Calling sequence:
;.i8;CALL EXECDO (COMAND)
;. ;where COMAND is a literal string in quotes, or an array or character
;-string which is the EXEC command to be executed
SEGMENT DATA
e.hndl: block 1 ;fork handle for exec fork
tmpjfn: block 1 ;jfn for command file
strptr: block 2 ;byte pointer to command to execute
;;strlen: block 1 ;byte count (or 0)
SEGMENT CODE
hello execdo
IFN FTN77,<
LDB T2,[POINT 4,0(AP),12] ;GET ARG TYPE
CAIE T2,15 ;descriptor?
JRST DO.66 ;no, old style
DMOVE T1,@0(AP) ;yes
MOVN T2,T2 ;make byte count negative
JRST DO.A
>;IFN FTN77
DO.66: XMOVEI T1,@0(AP)
TLNE T1,-1 ;extended addressing?
TXOA T1,<61B5> ;yes, use global type pointer
HRLI T1,(POINT 7,0) ;no, use local byte pointer
CLEAR T2,
DO.A: DMOVEM T1,STRPTR
SKIPE E.HNDL ;do we already have an exec?
JRST FORKOK ;yes, go run it.
;The EXEC has not yet been fired up, so we will create the fork now
;and feed it a POP command only, with output suppressed, to avoid the
;EXEC herald normally typed when it starts up.
movx t1,cr%cap ;create a fork with our capabilities
cfork%
erjmp jshlt0##
movem t1,e.hndl ;store the handle
movx t1,<gj%sht!gj%old>
hrroi t2,[asciz/SYSTEM:EXEC.EXE/]
gtjfn%
erjmp jshlt0##
hrl t1,e.hndl ;handle for GET%
clear t2,
get%
erjmp jshlt0##
movx t1,<gj%sht!gj%old>
hrroi t2,[asciz/SYS:POP.CMD/]
gtjfn%
erjmp jshlt0##
movem t1,tmpjfn
movx t2,.nulio ;suppress output to avoid herald
call runit
move t1,tmpjfn
closf%
erjmp jshlt0##
;fall into forkok
;fall into forkok
;FORKOK - build command file and run the exec with that command file
;as input.
forkok:
movx t1,<gj%sht!gj%tmp!gj%fou>
hrroi t2,[asciz/TEMP-EXEC-COMMAND.TMP/]
gtjfn%
erjmp jshlt0##
movem t1,tmpjfn
movx t2,<7b5!of%wr>
openf%
erjmp jshlt0##
dmove t2,strptr
clear t4
sout%
hrroi t2,[asciz/
POP
/]
sout%
ifn ftshow,<
tmsg <[Executing command ">
movei t1,.priou
dmove t2,strptr
sout%
tmsg <"]
>
>;ifn ftshow
hrrz t1,tmpjfn
txo t1,co%nrj
closf%
erjmp jshlt0##
seto t2, ;use terminal for .priou
call runit
hrrz t1,tmpjfn ;close the temp file again
txo t1,co%nrj
closf%
erjmp jshlt0##
hrrz t1,tmpjfn ;delete and expunge the temp file
txo t1,df%exp
delf%
erjmp jshlt0##
ret
;RUNIT - call with jfn for .priou in t2
runit: move t1,e.hndl ;set jfns for that exec to read from file.
hrl t2,tmpjfn
spjfn%
erjmp jshlt0##
move t1,tmpjfn ;re-open file for input now
movx t2,<7b5!of%rd>
openf%
erjmp jshlt0##
move t1,e.hndl ;start the fork
clear t2, ;normal start
e.strt: sfrkv%
erjmp jshlt0##
e.wait: wfork% ;wait for it to finish (POP)
erjmp jshlt0##
rfsts%
erjmp jshlt0##
ldb t1,[point 17,t1,17] ;get rf%sts
cain t1,.rfhlt ;did it hald voluntarily
ret ;yes
tmsg <?Error in EXEC fork termination>
movei t1,.priou
hrlo t2,e.hndl
clear t3,
erstr%
erjmp jshlt0##
erjmp jshlt0##
ret
prgend
title DDT - enter DDT - load DDT if necessary...
subttl NH Samuelson, 2644, 7/8/81
SEARCH SLAUNV
SLAPLG
;+.hl1 DDT
;Load DDT if it is not already loaded, then transfer control to it.
;-This routine takes no arguments and is callable from any language.
;Note - this was stolen from LIBMAC, which stole it from FOROTS...
SEGMENT CODE
HELLO DDT
MOVE 1,[.FHSLF,,770] ;[114] LOOK AT PAGE 770
RPACS% ;[114] GET PAGE ACCESS BITS
TXNN 2,PA%PEX ;[114] DOES PAGE 770 EXIST?
JRST MAPDDT ;[114] NO, GO MAP IN UDDT.EXE
MOVE 1,770000 ;[114] GET DDT ENTRY VECTOR
CAMN 1,[JRST 770002] ;[114] IS IT REALLY DDT?
JRST GODDT ;[114] YES, JUMP TO IT
MAPDDT: MOVEI 1,.FHSLF ;[114] GET ENTRY VECTOR LOC
GEVEC%
PUSH P,2 ;[114] SAVE SINCE GET WRECKS IT
MOVX 1,GJ%SHT+GJ%OLD ;[114] SHORT FORM, FILE MUST EXIST
HRROI 2,[ASCIZ /SYS:UDDT.EXE/] ;[114] DDT
GTJFN% ;[114] FIND IT
ERJMP ERR11 ;[114] NOT THERE, CAN'T HELP
HRLI 1,.FHSLF ;[114] MAP INTO THIS FORK
GET% ;[114] READ IN DDT
ERJMP ERR11 ;[114] CAN'T
DMOVE 1,116 ;[114] GET SYMBOL TABLE POINTERS
MOVEM 1,@770001 ;[114] STORE FOR DDT
MOVEM 2,@770002
POP P,2 ;[114] GET ENTRY VECTOR BACK
MOVEI 1,.FHSLF ;[114] THIS FORK
SEVEC% ;[114] RESTORE ENTRY VECTOR
GODDT: TMSG <Type PDDT$G to continue
>
JRST 770000 ;jump into DDT
err11: TMSG <
%Sorry, I cant seem to get DDT for you
>
PDDT:: RET
prgend
title CLEAR - screen clear routine for all supported terminals
subttl NH Samuelson, 2644, 8/8/80
SEARCH SLAUNV
SLAPLG
;+.hl1 CLEAR
;Clear the screen of any supported terminal capable of it.
;-This routine takes no arguments and is callable from any language.
SEGMENT CODE
HELLO CLEAR
PUSH P,P1 ;save some acs
PUSH P,T3
PUSH P,T2
MOVX T1,.CTTRM ;jobs controlling terminal
GTTYP% ;get its terminal type
MOVE P1,T2 ;save it
CAIGE T2,MAX.TY ; more than the number supported?
SKIPN BLNKTB(T2) ; yes, able to blank on this type?
JRST BLANK3 ; no, return
RFMOD% ;get the mode word
PUSH P,T2 ;save it
TXZ T2,TT%DAM ;no translation
SFMOD% ;change output mode temporarily
MOVX T2,.MORXO ;get current "pause on end-of-page" setting
MTOPR%
PUSH P,T3 ;save it
MOVX T2,.MOXOF ;set no pause on end-of-page
MOVX T3,.MOOFF
MTOPR%
MOVE T1,BLNKTB(P1) ; get blanking sequence or address
TXOE T1,.LHALF ; was it an address (LH=0)?
HRROI T1,BLNKTB(P1) ; no, sequence 4 chars or less, set up address
PSOUT% ; output the sequence
MOVEI T1,.PRIOU ; wait for it to get out
DOBE%
SETZ T2, ; tell monitor we are at top of page
SFPOS%
MOVEI T1,^D500 ; give terminal a chance to do it
DISMS%
blank2: MOVX T1,.CTTRM ;jobs controlling terminal
POP P,T3 ;get original "pause on end-of-page" bit
MOVX T2,.MOXOF
MTOPR%
POP P,T2 ;get original mode word
SFMOD% ;restore it
blank3: POP P,T2 ;restore the acs
POP P,T3
POP P,P1
RET
DEFINE CLRASCII <BYTE (7) .CHESC,"H",.CHESC,"J",0> ; ASCII screen clear
DEFINE CLRANSI <[BYTE (7) .CHESC,"[","H",.CHESC,"[","J",0]> ; ANSI standard
DEFINE FORMFEED <BYTE (7) .CHFFD,0> ;Traditional screen clear
BLNKTB: 0 ; 0 TTY33
0 ; 1 TTY35
0 ; 2 TTY37
0 ; 3 TI
BYTE (7) .CHCNZ,0 ; 4 ADM-3A
BYTE (7) .CHCRB,.CHCCF,0 ; 5 Datamedia 2500
CLRANSI ; 6 VT132
FORMFEED ; 7 Concept 100
0 ; 8 default
0 ; 9 PTY, NVT (aka "ideal")
BYTE (7) .CHCRB,.CHCUN,.CHCUN,.CHCUN,0 ;10 VT05
CLRASCII ; 11 VT50
0 ; 12 LA30
BYTE (7) .CHCRB,.CHCUN,0 ;13 GT40
0 ; 14 LA36
CLRASCII ; 15 VT52
CLRANSI ; 16 VT100
0 ; 17 LA38
0 ; 18 LA120
BYTE (7) 176,.CHCBS,0 ; 19 Hazeltine 1500
FORMFEED ; 20 C108
FORMFEED ; 21 CG108
BYTE (7) .CHCNY,.CHVTB,0 ; 22 Datamedia 1520
BYTE (7) .CHESC,"+",0 ; 23 Soroc 120
CLRASCII ; 24 HP264x
BYTE (7) .CHCNX,.CHCNW,0 ; 25 VC404
CLRANSI ; 26 WICAT/T7000
CLRANSI ; 27 ANSI
BYTE (7) .CHCNZ,0 ; 28 ADM-5
CLRANSI ; 29 Selinar VT100
CLRANSI ; 30 Retrographics V1 VT100
CLRANSI ; 31 Retrographics V2 VT100
FORMFEED ; 32 ADDS Viewpoint
[BYTE (7) "`","E","R","A",";",0] ; 33 Tektronix 4025
BYTE (7) .CHESC,"*",0 ; 34 Televideo 912
CLRANSI ; 35 VT125
CLRANSI ; 36 VK100 (GIGI)
CLRANSI ; 37 VT102
CLRASCII ; 38 H19
CLRANSI ; 39 VT131
CLRANSI ; 40 VT200
FORMFEED ; 41 Glass Teletype
BYTE (7) .CHESC,.CHFFD,0; 42 Tektronix 4014
max.ty==.-blnktb
PRGEND
TITLE MOVE - MOVE CHARACTERS
search slaunv
slaplg
;;
;+.tp10.HL1 MOVE
;.F.J;This FORTRAN callable subroutine moves ASCII characters,
;assuming 8 (left-justified) characters per double word of memory.
;.B1.NF.NJ;Calling sequence:
;.I5; CALL MOVE(A,I,B,J,N)
;.F.J;which causes N characters to be moved from B, beginning with the
;Jth character (counting the first one as 1) to A, beginning at the Ith
;-;character position. If N <= 0, no characters are moved.
;;
ENTRY MOVE
;;
MOVE:: MOVE 0,@4(16) ;AC0 = N
JUMPLE 0,EXIT ;EXIT IF NOTHING TO DO
CLEAR 1, ;TEST FOR EXTENDED ADDRESSING
XHLLI 1,. ;GET SECTION NUMBER
MOVEM 1,XFLAG# ;STORE AS A FLAG
;
; CONSTRUCT BYTE POINTER FOR A
;
XMOVEI 1,@0(16) ;AC1 = ADDR(A)
MOVE 2,@1(16) ;AC2 = I
SOJ 2, ;ADJUST OFFSET FOR FIRST CHARACTER TO 0
IDIVI 2,^D8 ;COMPENSATE FOR 8 CHARACTERS PER "WORD"
LSH 2,1 ; REALLY, PER DOUBLE-WORD
ADDI 1,(2) ;ALMOST DONE ...
CAILE 3,4 ;CHECK WHETHER ON THE LEFT SIDE ...
AOJ 1, ; OR THE RIGHT SIDE
SKIPE XFLAG ;EXTENDED ADDRESSING?
TDOA 1,XPNTRS(3) ;YES, USE ONE-WORD GLOBAL POINTER FORMAT
HLL 1,PNTRS(3) ;AC1 = BYTE POINTER FOR A
;
; CONSTRUCT BYTE POINTER FOR B
;
XMOVEI 4,@2(16) ;AC2 = ADDR(B)
MOVE 5,@3(16) ;AC3 = J
SOJ 5, ;ADJUST OFFSET FOR FIRST CHARACTER TO 0
IDIVI 5,^D8 ;COMPENSATE FOR 8 CHARACTERS PER "WORD"
LSH 5,1 ; REALLY, PER DOUBLE-WORD
ADD 4,5 ;ALMOST DONE ...
CAILE 6,4 ;CHECK WHETHER ON THE LEFT SIDE ...
AOJ 4, ; OR THE RIGHT SIDE
SKIPE XFLAG ;EXTENDED ADDRESSING?
TDOA 4,XPNTRS(6) ;YES, USE ONE-WORD GLOBAL POINTER FORMAT
HLL 4,PNTRS(6) ;AC4 = BYTE POINTER FOR B
;
; MOVE ONE CHARACTER AT A TIME
;
MVCLUP: ILDB 7,4 ;LOAD CHARACTER FROM B(*)
IDPB 7,1 ;STORE CHARACTER INTO A(*)
SOJE 0,EXIT ;QUIT IF COUNTER GOES TO 0
;
; UPDATE BYTE POINTER IF DOUBLE-WORD BOUNDARY CROSSED
;
AOJ 3, ;UPDATE A(*)
CAIE 3,8 ;CHECK FOR DOUBLE-WORD BOUNDARY
JUMPA .+4 ;IF STILL WITHIN DOUBLE-WORD
SETZ 3, ;BOUNDARY CROSSED: CLEAR CHARACTER COUNTER
IBP 1 ;INCREMENT BYTE POINTER PAST BOUNDARY
IBP 1 ; DITTO
;
AOJ 6, ;UPDATE B(*)
CAIE 6,8 ;CHECK FOR DOUBLE-WORD BOUNDARY
JUMPA MVCLUP ;IF STILL WITHIN DOUBLE-WORD
SETZ 6, ;BOUNDARY CROSSED: CLEAR CHARACTER COUNTER
IBP 4 ;INCREMENT BYTE POINTER PAST BOUNDARY
IBP 4 ; DITTO
JUMPA MVCLUP ;GO BACK FOR MORE PUNISHMENT
;
; EXIT -- MOVE COMPLETED
;
EXIT: POPJ 17, ;GO BACK TO CALLER
;
; BYTE POINTER TEMPLATE
;
PNTRS: POINT 7,0
POINT 7,0,6
POINT 7,0,13
POINT 7,0,20
POINT 7,0,27
POINT 7,0
POINT 7,0,6
POINT 7,0,13
XPNTRS: 61B5
62B5
63B5
64B5
65B5
61B5
62B5
63B5
PRGEND
TITLE JOBENV - GET CURRENT JOB ENVIRONMENT PARAMETERS
SEARCH MONSYM, MACSYM
.REQUE REL:MACREL
;
;+.HL1 JOBENV
;.J.F;This FORTRAN callable subroutine stores into COMMON-BLOCK /CJE1/
;various aspects of the execution job environment.
;.B1.NF.NJ;Calling sequence:
;.I5;CALL JOBENV
;where the following declaration for /CJE1/ is assumed:
;.I5;COMMON /CJE1/ USERID(4),IBATCH,IBAUD,ITERM
;-and the variable USERID is defined to be double precision.
;
; DECLARE /CJE1/
;
P==17
T0=0
T1=1
T2=2
T3=3
IDSIZE=8
LOC 0
USERID: BLOCK IDSIZE
IBATCH: BLOCK 1
IBAUD: BLOCK 1
ITERM: BLOCK 1
COMLEN=.-USERID
.COMMON CJE1[COMLEN]
RELOC
;STORAGE FOR INFO RETURNED FROM GETJI
LN$GJI==.JIBAT+1
JOBINF: BLOCK LN$GJI
SIXBIT/JOBENV/ ;FOR FORTRAN TRACE
JOBENV: ENTRY JOBENV
;CLEAR OUT EVERYTHING
MOVE T1,[ASCII/ /] ;5 BLANKS
MOVEM T1,CJE1+USERID
MOVE T1,[CJE1+USERID,,CJE1+USERID+1]
BLT T1,CJE1+IDSIZE-1
CLEARM CJE1+IDSIZE
MOVE T1,[CJE1+IDSIZE,,CJE1+IDSIZE+1]
BLT T1,CJE1+COMLEN-1
IF2,<PRINTX JOBENV ASSEMBLED FOR TOPS-20>
;GET LOTS OF JOB INFO FROM THE MONITOR FIRST
T20: SETO T1,
MOVE T2,[-LN$GJI,,JOBINF]
CLEAR T3,
GETJI%
JSHLT
;GET USER NAME
HRROI T1,CJE1+USERID
MOVE T2,JOBINF+.JIUNO
DIRST%
JSHLT
MOVEI T2," "
IDPB T2,T1
;FIND OUT IF IT IS BATCH
MOVN T1,JOBINF+.JIBAT
MOVEM T1,CJE1+IBATCH
;GET THE BAUD RATE
MOVEI T1,.PRIOU
MOVEI T2,.MORSP
MTOPR%
HRRZM T3,CJE1+IBAUD
;GET THE TERMINAL TYPE
MOVEI T1,.PRIOU
GTTYP%
MOVEM T2,CJE1+ITERM
;ALL DONE, RETURN
POPJ P,
PRGEND
TITLE PARSE - MACRO ROUTINES TO PARSE COMMAND USING COMND JSYS
SUBTTL NH SAMUELSON, 2644, 7/80
SEARCH SLAUNV
SLAPLG
ND DEBUG,0
IFN DEBUG,<IF2,<PRINTX DEBUG VERSION>>
ND PLTMAX,8 ; MAX # PLOTS
.REQUE REL:MACREL
;+.tp5,hl1 PARSE
;.f.j;This collection of subroutines uses the COMMD JSYS implemented
;in TOPS-20 to carry out SANCA command parsing.
;-
;.NJ.RM72
;THIS COLLECTION OF MACRO ROUTINES IS DESIGNED TO MAKE IT EASY FOR A
;USER TO PARSE COMMANDS USING THE COMND JSYS WHICH IMPLEMENTS THE TOPS-20
;STANDARD COMMAND SCANNER.
;INCLUDED ARE A NUMBER OF MACROS TO DEFINE TABLES. INTERESTED USERS SHOULD
;EXAMINE THE SECTION IN THE TOPS-20 MONITOR CALLS MANUAL FOR INFORMATION
;ON USE OF THE COMND JSYS AND THE TBLUK JSYS.
;.B1;THERE ARE A FEW DATA STRUCTURES USED WITH THE COMND JSYS WHICH SHOULD
;BE UNDERSTOOD BEFORE ANYONE TRIES TO USE THIS PACKAGE.
;.B1;CSB - COMMAND STATUS BLOCK - THIS POINTS TO BUFFERS FOR THE COMMAND.
;IT ALSO POINTS TO THE PROMPT STRING.
;.B1;FDB - FUNCTION DESCRIPTOR BLOCK - THERE WILL BE MANY OF THESE. EACH ONE
;DESCRIBES A PARTICULAR TYPE OF POSSIBLITY AT A PARTICULAR POINT IN THE
;COMMAND AND CAN POINT TO ALTERNATIVE FUNCTION DESCRIPTOR BLOCKS.
;FOR EXAMPLE IT MIGHT BE THAT AT A PARTICULAR POINT IN A COMMAND EITHER
;A FILE NAME, OR A KEYWORD, OR A SWITCH, OR AN END OF LINE COULD OCCUR.
;THAT WOULD REQUIRE FOUR DIFFERENT FDBS.
;.B1;KEYWORD TABLES - ANY FDB WHICH SPECIFYS A KEYWORD MUST POINT TO
;A TABLE OF ALLOWABLE KEYWORDS. THE TABLE INCLUDES THE KEYWORD STRING,
;A VALUE, AND OPTIONAL FLAGS TO INDICATE SUCH THINGS AS SPECIAL ABBREVIATIONS,
;INVISIBLE WORDS (ALLOWABLE BUT NOT SEEN WHEN ? IS TYPED), AND OTHERS.
;
;NOISE - INCLUDE A 'NOISE' WORD IN THE COMMAND. NOISE WORDS ARE TYPED
;BY THE OPERATING SYSTEM WHEN THE PRECEDING FIELD IS ENDED WITH <ESC>
;TO GUIDE THE USES ON WHAT KIND OF INPUT IS EXPECTED NEXT. THEY CAN ALSO
;BE TYPED IN BY THE USER BUT ARE IGNORED IF SPELLED CORRECTLY.
;
DEFINE NOISE(TEXT),<
XMOVEI T2,[FLDDB. .CMNOI,,<-1,,[ASCIZ/TEXT/]>]
CALL DOCMDE
>;END NOISE MACRO
SUBTTL DEFAULT VALUES AND DATA STRUCTURES
LN$BUF==^D144 ; MAX LENGTH OF COMMANDS
BUFLEN==<LN$BUF/5>+1 ; #WORDS TO HOLD THAT
LN$PAR==5 ; LENGTH OF LIST OF PARSED VALUES
LN$PLT==PLTMAX*5 ; TOTAL LENGTH OF PLOT TABLE
LN$SWI==5 ; LENGTH OF SWITCH TABLE
SAVESP: BLOCK 1
LIMOK: BLOCK 1
CMDBUF: BLOCK BUFLEN ; THE WHOLE COMMAND GOES HERE
ATMBUF: BLOCK BUFLEN ; EACH ATOM GOES HERE
CSB: CM%RAI!REPAR ; FLAGS,,REPARSE-ADDRESS
.PRIIN,,.PRIOU ; WHERE INPUT COMES FROM AND OUTPUT GOES
POINT 7,PROMPT ; POINTER TO PROMPT STRING
POINT 7,CMDBUF ; POINTER TO START OF TEXT BUFFER
POINT 7,CMDBUF ; POINTER TO NEXT INPUT TO PARSE
LN$BUF ; COUNT OF SPACE IN BUFFER
0 ; COUNT OF CHARS LEFT IN BUFFER
POINT 7,ATMBUF ; POINTER TO ATOM BUFFER
LN$BUF ; LENGTH OF ATOM BUFFER
; 0 ; ADDRESS OF GTJFN ARG BLOCK (NOT USED HERE)
PROMPT: ASCIZ/*/ ; CHANGE THIS TO ANY STRING YOU LIKE!!!!!
FDBRPN: FLDDB. .CMTOK,,<POINT 7,[ASCIZ/)/]>,,<)> ; RIGHT PAREN
FDBLIM: FLDDB. .CMTOK,CM%SDH,<POINT 7,[ASCIZ/(/]>,<"(" FOR Y LIMITS>,,FDBOBK
FDBOBK: FLDDB. .CMTOK,CM%SDH,<POINT 7,[ASCIZ/[/]>,<"[" FOR X LIMITS>,,FDBDLS
FDBDLS: FLDDB. .CMKEY,,DLSTBL,,,FDBSWT ; DATA/LOG
FDBCSC: FLDDB. .CMKEY,,CSCTBL,,,FDBSWT ; CONTROLLED SOURCES
FDBSWT: FLDDB. .CMSWI,,SWTTBL,,,FDBCFM ; SWITCHES
FDBCFM: FLDDB. .CMCFM ; CONFIRM
;THE FOLLOWING MUST STAY TOGETHER
.FDB00:
FDBVCO: FLDDB. .CMKEY,,VOLTBL,,,FDBCUO ; VOLTAGE OR CURRENT ONLY
FDBCUO: FLDDB. .CMKEY,,CURTBL
FDBVPL: FLDDB. .CMKEY,,VOLTBL,,,FDBCPL ; PLOT - V OR I OR LIMITS, ETC
FDBCPL: FLDDB. .CMKEY,,CURTBL,,,FDBLIM
FDBVPR: FLDDB. .CMKEY,,VOLTBL,,,FDBCPR ; PRINT - V OR I SWITCHES ONLY
FDBCPR: FLDDB. .CMKEY,,CURTBL,,,FDBOBK
.FDB99:
DEFINE TBL1,<
XTV CIRCUIT-ELEMENT-SUMMARY,.CKELM
XTV CLEAR,.CLEAR
XTV ELEMENT-NODE-TABLE
XTV ERRORS
XTV EXIT,.CONFIRM
XTV FOURIER-ANALYSIS,.ALNUM
XTV HELP,.CONFIRM
XTV INITIAL-TRANSIENT-SOLUTION
XTV INPUT-LISTING
XTV JOB-STATISTICS-SUMMARY
XTV MODEL-PARAMETERS,.MDPRM
XTV OPERATING-POINT-INFORMATION,.OPPIN
XTV OPTIONS-SUMMARY
XTV PLOT,.PLOT
XTV PRINT,.PRINT
XTV SENSITIVITY-ANALYSIS,.ALNUM
XTV SMALL-SIGNAL-BIAS-SOLUTION
XTV TEMPERATURE-ADJUSTED-VALUES,.TADJV
XTV TRANSFER-FUNCTION
>;END TBL1
DEFINE XTV(A,B),<TV(A)> ; BUILD THE KEYWORD TABLE
ZZZZ==0
FWDTBL: LN$FWD,,LN$FWD
TBL1
LN$FWD==.-FWDTBL-1
DEFINE XTV(A,B<.CKSWT>),<IFIW B> ; BUILD THE DISPATCH TABLE
FWDDSP: TBL1
;SECOND LEVEL COMMAND TABLES
ZZZZ==4 ; 1-4 ARE CONTROLLED SOURCES
ELMTBL: LN$ELM,,LN$ELM
KEY ALL,0
TV BJTS
TV CAPACITORS-AND-INDUCTORS
TV DIODES
TV INDEPENDENT-SOURCES
TV JFETS
TV MOSFETS
TV MUTUAL-INDUCTORS
TV RESISTORS
TV SUBCIRCUIT-CALLS
TV TRANSMISSION-LINES
LN$ELM==.-ELMTBL-1
;MODEL PARAMETERS
ZZZZ==4 ; 1-4 ARE CONTROLLED SOURCES
MDPTBL: LN$MDP,,LN$MDP
KEY ALL,0
TV BJTS
TV DIODES
TV JFETS
TV MOSFETS
LN$MDP==.-MDPTBL-1
;TEMPERATURE ADJUSTED VALUES
ZZZZ==0
TADTBL: LN$TAD,,LN$TAD
KEY ALL,0
TV BJT-MODEL-PARAMETERS
TV DIODE-MODEL-PARAMETERS
TV JFET-MODEL-PARAMETERS
TV MOSFET-MODEL-PARAMETERS
TV RESISTORS
LN$TAD==.-TADTBL-1
;VOLTAGE/CURRENT CONTROLLED VOLTAGE/CURRENT SOURCES
CSCTBL: LN$CSC,,LN$CSC
KEY CURRENT-CONTROLLED,0
KEY VOLTAGE-CONTROLLED,2
LN$CSC==.-CSCTBL-1
ZZZZ==0
CSSTBL: LN$CSS,,LN$CSS
TV CURRENT-SOURCES
TV VOLTAGE-SOURCES
LN$CSS==.-CSSTBL-1
DLSTBL: LN$DLS,,LN$DLS
KEY DATA,2
KEY LOG,3
LN$DLS==.-DLSTBL-1
;SWITCHES
SWTTBL: LN$SWT,,LN$SWT
KEY <LINES:>,1
KEY <TEMPERATURE:>,0
LN$SWT==.-SWTTBL-1
;PRINT/PLOT KEYWORD TABLES
ZZZZ==0
PLPTBL: LN$PLP,,LN$PLP
TV AC
TV DC
TV TRANSIENT
LN$PLP==.-PLPTBL-1
;VOLTAGES TO PLOT
ZZZZ==0
VOLTBL: LN$VOL,,LN$VOL
TV V
TV VDB
TV VI
TV VM
TV VP
TV VR
LN$VOL==.-VOLTBL-1
;CURRENTS TO PLOT
MAXVOL==ZZZZ ;NOTE - ZZZZ NOT RESET TO 0 HERE
CURTBL: LN$CUR,,LN$CUR
TV I
TV IDB
TV II
TV IM
TV IP
TV IR
LN$CUR==.-CURTBL-1
VIONLY: LN$VIO,,LN$VIO
ZZZZ==MAXVOL
TV I
ZZZZ==0
TV V
LN$VIO==.-VIONLY-1
SUBTTL PROMPT AND GET THE FIRST WORD
HELLO (PARSE) ; ENTRY POINT
XMOVEI P3,@1(AP) ; GET ADDRESS OF SWITCH TABLE
MOVEM P,SAVESP ; SAVE THE STACK POINTER IN CASE OF ERROR
AGAIN:
XMOVEI T2,[FLDDB. .CMINI] ; INITIALIZE (TYPE PROMPT)
CALL DOCMD
JFCL
REPAR: MOVE P,SAVESP ; RESTORE THE STACK IN CASE OF ERROR
XMOVEI P4,@0(AP) ; GET ADDRESS OF PARSE TABLE
CLEARM (P4) ; CLEAR IT
MOVEI T0,LN$PAR-1
XMOVEI T1,(P4)
XMOVEI T2,1(T1)
XBLT T0,
XMOVEI P2,@2(AP) ; GET ADDRESS OF PLOTS TABLE
CLEARM (P2) ; CLEAR IT TOO
MOVEI T0,LN$PLT-1
XMOVEI T1,(P2)
XMOVEI T2,1(T1)
XBLT T0,
XMOVEI T2,[FLDDB. .CMKEY,,FWDTBL,,<CLEAR>]
CALL DOCMDE ; GET THE FIRST KEYWORD
HRRZ T2,(T2) ; GET VALUE FOR IT
MOVEM T2,0(P4) ; STORE IN PARSE TABLE
CAIL T2,2 ;KLUDGE FOR JERRY
SOS (P4) ;KLUDGE - DECREMENT AROUND CLEAR
JRST @FWDDSP-1(T2) ; GO FOR NEXT FIELD
SUBTTL PARSE INTERMEDIATE FIELDS
;CLEAR THE SCREEN
.CLEAR: CALL .CONFIRM
CALL CLEAR##
JRST AGAIN
;CIRCUIT ELEMENT SUMMARY
.CKELM: NOISE <FOR>
XMOVEI T2,[FLDDB. .CMKEY,,ELMTBL,,ALL,FDBCSC]
LSTSWT: CALL DOCMDE ; READ KEYWORD OR SWITCHES
HRROI T3,(T3) ; GET LOCAL ADDRESS
LDB T1,[POINTR .CMFNP(T3),CM%FNC]
CAIE T1,.CMKEY ; WAS IT A KEYWORD?
JRST .CKSWX ; CHECK FOR SWITCH OR CONFIRM
CAIE T3,FDBCSC ; WAS IT CONTROLLED SOURCE
JRST NOTCSS ; NO
HRRZ T4,(T2) ; GET CONTROL TYPE
XMOVEI T2,[FLDDB. .CMKEY,,CSSTBL]
CALL DOCMDE
HRRZ T2,(T2) ; GET SOURCE TYPE
ADDI T2,(T4) ; AND CONTROL TYPE
CAIA
NOTCSS: HRRZ T2,(T2) ; GET VALUE
MOVEM T2,1(P4) ; STORE IN PARSE TABLE
JRST .CKSWT ; AND LOOK FOR POSSIBLE SWITCHES
;MODEL PARAMETERS (FOR)
.MDPRM: NOISE <FOR>
XMOVEI T2,[FLDDB. .CMKEY,,MDPTBL,,ALL,FDBSWT]
JRST LSTSWT ; GET FROM LIST OR SWITCHES
;OPERATING POINT INFORMATION
.OPPIN: NOISE <FOR>
XMOVEI T2,[FLDDB. .CMKEY,,MDPTBL,,ALL,FDBCSC]
JRST LSTSWT ; GET FROM LIST OR SWITCHES
;TEMPERATURE ADJUSTED VALUES
.TADJV: NOISE <FOR>
XMOVEI T2,[FLDDB. .CMKEY,,TADTBL,,ALL,FDBSWT]
JRST LSTSWT
;FOURIER ANALYSIS .OR...
;SENSITIVITY ANALYSIS
.ALNUM: MOVEI T1,1 ;ONLY ONE PARAMETER
MOVEM T1,2(P4) ;STORE IN PARTBL
XMOVEI T2,[FLDDB. .CMKEY,,VIONLY,,,FDBSWT]
CALL DOCMDE
HRROI T3,(T3) ; GET LOCAL ADDRESS
LDB T1,[POINTR .CMFNP(T3),CM%FNC]
CAIE T1,.CMKEY ; WAS IT A KEYWORD?
JRST .CKSWX ; NO, MUST HAVE BEEN SWITCH OR CONFIRM
CALL GTNODE ; GET THE NODE(S)
JRST .CKSWT
SUBTTL PLOT OR PRINT COMMAND
;PRINT .OR...
.PRINT: TDZA T1,T1 ; PRINT CANT HAVE LIMITS
;PLOT
.PLOT: SETO T1, ; PLOT CAN HAVE LIMITS
MOVEM T1,LIMOK ; SAVE LIMIT FLAG
NOISE <TYPE>
XMOVEI T2,[FLDDB. .CMKEY,,PLPTBL]
CALL DOCMDE
HRRZ T2,(T2) ; GET VALUE FOR PLOT TYPE
MOVEM T2,1(P4) ; STORE IN PARSE TABLE
MOVEI T2,FDBVCO ; VOLTAGE OR CURRENT ONLY
JRST GETPR1
GETPRM: MOVE T1,2(P4) ; GET # PLOTS SO FAR
CAIL T1,PLTMAX ; HAVE WE REACHED THE LIMIT
JRST GETPR9 ; YES
SKIPN LIMOK ; WAS IT PRINT OR PLOT?
SKIPA T2,[FDBVPR] ; PRINT
MOVEI T2,FDBVPL ; PLOT
GETPR1: CALL DOCMDE
CAIL T3,.FDB00 ; WAS IT A PARAM
CAIL T3,.FDB99
JRST GETLIM ; NO, CHECK FOR LIMITS OR OTHER OPTIONS
MOVE T1,2(P4) ; GET # PLOTS SO FAR
IMULI T1,5 ; LENGTH OF EACH PLOT ENTRY
XMOVEI P2,@2(AP) ; POINT TO NEXT ROW OF PLOT TABLE
ADDI P2,(T1)
AOS 2(P4) ; INCREMENT COUNT # OF PLOTS REQUESTED
CALL GTNODE ; GET NODE(S)
JRST GETPRM
GETPR9: SKIPN LIMOK ; WAS IT PLOT OR PRINT
JRST .CKSWT ; PRINT - NO LIMITS ALLOWED
MOVEI T2,FDBLIM
CALL DOCMDE
GETLIM: CAIE T3,FDBLIM ; WAS IT A LIMIT
JRST GETPR3 ; NO
XMOVEI T2,[FLDDB. .CMFLT,CM%SDH,,<low y limit>] ; PARSE A FLOATING POINT NUMBER
CALL DOCMDE
MOVEM T2,3(P2) ; STORE IN PLOT TABLE
XMOVEI T2,[FLDDB. .CMCMA,,,,<,>]
CALL DOCMDE
XMOVEI T2,[FLDDB. .CMFLT,CM%SDH,,<high y limit>] ; PARSE A FLOATING POINT NUMBER
CALL DOCMDE
MOVEM T2,4(P2) ; STORE IN PLOT TABLE
MOVEI T2,FDBRPN
CALL DOCMDE
JRST GETPRM ; GET UP TO THE MAX # PARAMS
GETPR2:
SKIPA T2,[FDBOBK] ; LOOK FOR OPEN BRACKET OR KEY (DATA,LOG)
GETDLS: MOVEI T2,FDBDLS ; ALLOW DATA or LOG IN ANY ORDER
CALL DOCMDE
GETPR3: CAIN T3,FDBOBK ; WAS IT "["
JRST XLIMIT ; YES, GET X LIMITS
CAIE T3,FDBDLS ; WAS IT A KEYWORD
JRST .CKSWX ; NO, MUST HAVE BEEN A SWITCH
HRRZ T2,(T2) ; GET OFFSET OF VARIABLE
ADD T2,P3 ; GET ADDRESS
SETOM (T2) ; SET IT TO TRUE
JRST GETDLS
XLIMIT: XMOVEI T2,[FLDDB. .CMFLT,CM%SDH,,<low x limit>] ; PARSE A FLOATING POINT NUMBER
CALL DOCMDE
MOVEM T2,3(P4) ; STORE IN PARSE TABLE
XMOVEI T2,[FLDDB. .CMCMA,,,,<,>]
CALL DOCMDE
XMOVEI T2,[FLDDB. .CMFLT,CM%SDH,,<high x limit>] ; PARSE A FLOATING POINT NUMBER
CALL DOCMDE
MOVEM T2,4(P4) ; STORE IN PARSE TABLE
XMOVEI T2,[FLDDB. .CMTOK,,<POINT 7,[ASCIZ/]/]>,,<]>]
CALL DOCMDE
JRST GETDLS
;GET A NODE NUMBER OR NODE NUMBER PAIR
GTNODE: HRRZ T2,(T2) ; GET PLOT VALUE TYPE
MOVEM T2,0(P2) ; STORE IN PLOT TABLE
XMOVEI T2,[FLDDB. .CMTOK,,<POINT 7,[ASCIZ/(/]>,,<(>]
CALL DOCMDE
MOVE T2,0(P2) ; GET PLOT VALUE TYPE AGAIN
CAILE T2,MAXVOL ; IS IT A VOLTAGE
JRST CURNOD ; NO, CURRENT
XMOVEI T2,[FLDDB. .CMNUM,CM%SDH,^D10,<first node>] ; GET A DECIMAL VALUE
CALL DOCMDE
MOVEM T2,1(P2) ; STORE IN PLOT TABLE
XMOVEI T2,[FLDDB. .CMCMA,CM%SDH,,<"," FOR SECOND NODE NUMBER>,<)>,FDBRPN]
CALL DOCMDE
HRROI T3,(T3)
LDB T1,[POINTR .CMFNP(T3),CM%FNC]
CAIE T1,.CMCMA ; WAS IT A COMMA
RET ; NO, WAS ), NO SECOND NODE
XMOVEI T2,[FLDDB. .CMNUM,CM%SDH,^D10,<second node>] ; GET A DECIMAL VALUE
CALL DOCMDE
MOVEM T2,2(P2) ; STORE IN PLOT TABLE
GTND.9: MOVEI T2,FDBRPN
CALLRET DOCMDE
CURNOD: XMOVEI T2,[FLDDB. .CMFLD,,,<voltage source name>] ; GET A STRING
CALL DOCMDE
MOVEI T3,^D9 ; GET UP TO 9 CHARS
MOVE T2,[POINT 7,ATMBUF]
MOVE T1,[POINT 7,1(P2)]
ILDB T0,T2 ; GET THE FIRST CHARACTER
CAIE T0,"V" ; MUST BE V
JRST [TMSG <
?The first character of a source name must be a "V">
JRST AGAIN]
IDPB T0,T1
CURN.1: ILDB T0,T2 ; GET A CHARACTER
JUMPE T0,CURN.2 ; END OF STRING IS NULL
IDPB T0,T1
SOJG T3,CURN.1
ILDB T0,T2 ; GET CHAR 11
JUMPN T0,[TMSG <
?Input string is too long>
JRST AGAIN]
JRST GTND.9 ; GET THE CLOSING PAREN
CURN.2: MOVEI T0," " ; FILL WITH BLANKS
IDPB T0,T1
SOJG T3,.-1 ; UP TO TEN CHARS
JRST GTND.9 ; GET THE CLOSING PAREN
SUBTTL CHECK FOR SWITCH OR CONFIRM
.CKSWT: MOVEI T2,FDBSWT
CALL DOCMDE
.CKSWX: CAIN T3,FDBCFM ; WAS IT CONFIRM?
RET ; YES, ALL DONE
HRRZ T4,(T2) ; GET OFFSET FOR SWITCH
ADD T4,P3 ; GET ADDRESS
XMOVEI T2,[FLDDB. .CMNUM,,^D10] ; GET A DECIMAL VALUE
CALL DOCMDE
MOVEM T2,(T4) ; STORE THE VALUE
JRST .CKSWT
SUBTTL DO THE COMND JSYS AND CHECK FOR ERRORS
DOCMD: MOVEI T1,CSB ; MUST POINT TO CSB
COMND
TXNN T1,CM%NOP ; DID IT PARSE CORRECTLY?
AOS (P) ; YES, GIVE SKIP RETURN
RET
.CONFIRM:
MOVEI T2,FDBCFM ; WAIT FOR CONFIRM...
; CALLRET DOCMDE ; ... THEN RETURN TO MAIN PROGRAM
DOCMDE: MOVEI T1,CSB
COMND
HRRZI T3,(T3) ; GET (LOCAL) FDB ADDRESS
TXNN T1,CM%NOP ; DID IT PARSE CORRECTLY
RET ; YES, RETURN
CMDERR: CALL JSERR0## ; GIVE ERROR MSG, CLEAR INPUT BUFFER
JRST AGAIN ; START OVER
SUBTTL DEBUG CODE
IFN DEBUG,<
STAK: BLOCK STKSIZ
F.PART: BLOCK LN$PAR
F.SWIT: BLOCK LN$SWI
F.PLOT: BLOCK LN$PLT
-3,,0
ARGLST: EXP F.PART
EXP F.SWIT
EXP F.PLOT
GO: MAKSTK
MOVEI T5,1000
LUPER: TMSG <THIS IS A TEST>
MOVEI AP,ARGLST
CALL PARSE
SOJG T5,LUPER
HALTF
END GO
> ;END IFN DEBUG
PRGEND
title BEEP - ring the bell every few seconds until stopped
subttl NH Samuelson, 2644, 7/82
SEARCH SLAUNV
SLAPLG
.REQUES SYS:MACREL
;+.hl1 BEEP
;start ringing the bell at the users terminal every few seconds
;and continue until NOBEEP is called.
;.b1;calling sequence:
;.i8;#...write prompt to users terminal...
;.i8;CALL BEEP (TIME0,TIMED)
;.i8;#...read from users terminal...
;.i8;CALL NOBEEP
;.b1.nf;where TIME0 is integer number of milli-seconds till first beep.
; if less than 500, one second will be used by default
; and TIMED is the delta to be added each time, if 0 then no delta,
; if negative then double each time
;.b1.f.nj;Time will be incremented in case user is not around, to avoid driving
;-neighbors wacko.
SEGMENT DATA
bepfrk: block 1 ;handle for fork
time0: block 1 ;initial time
timed: block 1 ;delta time
time1: block 1 ;current time interval
SEGMENT CODE
hello beep
skipe t1,bepfrk ;do we have a beep-fork now?
jrst frkok ;yes
movx t1,<cr%map!cr%st!bepsta> ;same map, start at bepsta
clear t2,
cfork%
erjmp jshlt0## ;loose
movem t1,bepfrk ;save fork handle
frkok: move t1,@0(ap) ;get TIME0
caige t1,^d500 ;at least half a second?
movei t1,^d1000 ;no - use one second for default
movem t1,time0 ;save it
move t1,@1(ap) ;get TIMED (ie: delta)
movem t1,timed
move t1,bepfrk ;fork handle
clear t2, ;no PC flags
xmovei t3,bepsta ;start address
xsfrk%
rfork% ;un-freeze it
ret
;NOBEEP - stop the beeping
hello nobeep
move t1,bepfrk
ffork% ;freeze the fork
ret
;This code runs in the other fork...
bepsta: move t1,time0 ;get initial time
movem t1,time1 ;save as current increment
bepcon:
disms% ;sleep
movei t1,.chbel ;type a bell
pbout%
skipge t1,timed ;get delta
move t1,time1 ;-delta means double it
addb t1,time1 ;sleep longer next time
jrst bepcon
PRGEND
title JSHLT0 - error handler for JSYS's
subttl DP Duggan, 2113, 3/84
SEARCH SLAUNV
SLAPLG
.REQUES SYS:MACREL
Hello Jserr0
Hrroi 1,[Asciz/
?/]
PSOUT%
Movei 1,.Priou
Hrloi 2,.Fhslf
Setzm 3
ERSTR%
Jfcl
Jfcl
Hrroi 1,[Asciz/
/]
PSOUT%
Popj 17,
Hello Jshlt0
Pushj 17,Jserr0
HALTF%
end