Trailing-Edge
-
PDP-10 Archives
-
basic17f
-
basicl.mac
There is 1 other file named basicl.mac in the archive. Click here to see a list.
TITLE BASIC V17F 23-MAR-81
SUBTTL IMPURE AREA
;***COPYRIGHT (C) 1969,1970,1971,1972,1973,1974,1975,1976,1977,1978,
;***1979,1980,1981
;***BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
COMMENT /
THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
TRANSFERRED.
THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
CORPORATION.
DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
/
PAGE
;ALPHABETICAL LIST OF INTERNALS.
INTERN ACTBL,APPLST,APPMAX,ARAROL,ARATOP,ARGROL;[224]
INTERN BA,BADGNN,BATCH,BGNTIM,BLOCK
INTERN C3,CADROL,CATFLG,CEIL,CHAFL2,CHAFLG,CLOSED,CMDROL,CODROL,COMTIM
INTERN COMTOP,CONROL,COPFLG,CORINC,CURBAS,CURDEV,CUREXT,CURLIN,CURNAM
INTERN DATAFF,DATLIN,DECROL,DETER,DEVBAS,DEVICE,DREL,DRMBUF,DSKSYS
INTERN ELECT1,ELECT2,ELECT3 ;[207] ADD SYMBOLS
INTERN ELETOP,ENT,ENTDSK,EOFFLG,ES2,EX1,EXTD,EXTFG
INTERN FADROL,FCLROL,FCNLNK,FCNROL,FILCNT,FILD,FILD1,FILDIR
INTERN FILFLG,FILNM,FILTYP,FIRSFL,FLOAT,FLOOR,FMTPNT,FORROL
INTERN FRSTLN,FUNAME,FUNLOW,FUNSTA
INTERN GSBROL,GTSTS
INTERN HEDFLG,HPOS
INTERN IBDSK,IBDSK2,IBF,IFFLAG,IFIFG,IFNFLG,INDSK
INTERN ININI1,INITO,INNDSK,INPFLA,INVFLG,INVLIM,INVLRG ;[240]
INTERN LADROL,LASREC,LASTLN,LEAD,LETSW,LIBFLG,LINB0,LINNUM
INTERN LINROL,LITROL,LOCLOF,LOK,LOKUP,LOWEST,LOWSTA,LZ
INTERN MARGIN,MARWAI,MASAPP,MIDSAV,MINFLG,MODBLK,MONLVL,MTIME
INTERN NEWOL1,NUMAPP,NUMCOT,NUMMSP,NUMRES,NXTROL
INTERN OBF,OBDSK,OBDSK2,ODF,OLDFLA,ONCESW,OUTDSK,OUTTDS
INTERN PAGCNT,PAGLIM,PAKFLA,PAKFLG,PARAM,PINPNM,PINPUT
INTERN PIVOT,PLIST,POINT,PREAD,PROTEC,PSHPNT,PSHROL,PTMROL
INTERN PTHBLK,QUEBLK,QUELEN,FILBLK ;[241]QUE BLOCK [234] PATH BLOCK
INTERN QLIST,QLSPEC,QUOFL1,QUOFLG,QUOTBL
INTERN RANCNT,RANTST,REAINP,REATMP,REFROL,REGPNT,RELROL,RENAMD,RENFLA
INTERN RENSW,RETUR1,REVFL,RNDDAT,RNDIDX,ROLMSK,ROLTOP,RUNFLA,RUNLIN
INTERN SADROL,SAVE1,SAVI,SB1M1,SB2M1,SCAROL,SEQPNT,SEXROL,SJOBRL
INTERN SAVEX1 ;[236]TEMP FOR APR INTERUPT
INTERN SJOBSA,SLTROL,SORCLN,SPEC,SRTDBA,STADSK,STARFL,STAROL,STMROL
INTERN STODSK,STOTRP,STQDSK,STRCTR,STRFCN,STRLEN,STRPTR
INTERN STWDSK,SVRBOT,SVRROL,SVRTOP,SWAPSS,SX
INTERN TABFG,TABLE,TABVAL,TEMLOC,TEMP1,TEMP2,TEMP3,TMPLOW,TMPPNT
INTERN TMPROL,TOPSTG,TRAIL,TRNFL2,TRNFLG,TRPLOC,TTYBUF,TTYPAG
INTERN TXTROL,TYI,TYO
INTERN UFD,USETID,USETOD,USGFLG,UUOH,UXFLAG
INTERN VALPTR,VARFRE,VARROL,VECT1,VECT2,VPAKFL,VRFBTB,VRFBOT
INTERN VRFSET,VRFTOP,VSPROL
INTERN WRIPRI,WRREFL
INTERN ZONFLG
;ALPHABETICAL LIST OF EXTERNALS.
EXTERN CMDCEI,CMDFLO,DECCEI,DECFLO,RELCEI,RELFLO,STACEI,STAFLO
EXTERN TRPMSG,UUOHAN
ONCESW: EXP -1 ;ONCE-ONLY SWITCH FOR START
;AFTERWARDS, THE CONSTANT ZERO.
VPAKFL: BLOCK 1 ;-1 IF VARIABLE SPACE PACKED.
;TEMPORARY STORAGE FOR RUN-TIME IFN SUBS
PIVOT: ES2: C3: BLOCK 1
SX: LZ: BLOCK 1
DEVBAS: BLOCK 1 ;< > 0 ON EXIT FROM FILNAM IF DEV IS FAKED BAS.
FILFLG: BLOCK 1
STARFL: BLOCK 1 ;***
COMTIM: BLOCK 1 ;-1=COMPILE TIME, 1=EXEC TIME, 0=COMMAND TIME.
FILTYP: BLOCK 1
CHAFL2: BLOCK 1
UXFLAG: BLOCK 1
DATAFF: BLOCK 1 ;DATA/READ FLG AND FIRST DATA PTR
TOPSTG: BLOCK 1 ;HIGHEST UNMOVEABLE(STODGY)ROLL
SVRBOT: BLOCK 1 ;BOTTOM OF STRING VECTOR POINTER SPACE.
SVRTOP:
ARATOP: BLOCK 1 ;TOP OF SPACE RESERVED FOR ARRAYS.
VARFRE: BLOCK 1 ;NEXT FREE WORD IN VARIABLE SPACE.
FCNLNK: BLOCK 1 ;LINK IN FCN AND GOSUB CALLS
CATFLG: BLOCK 1 ;FLAG AND LOOP COUNTER FOR CAT, XFOR, ETC.
CHAFLG: BLOCK 1 ;-1 IF CHAINING, 0 OTHERWISE.
TEMLOC: BLOCK 1
ININI1: BLOCK 1
DEVICE: BLOCK 2
UFD: BLOCK 4
TABFG: BLOCK 1
TEMP1: BLOCK 1
TEMP2: BLOCK 1
TEMP3: BLOCK 1
DRMBUF: BLOCK 203
BLOCK 415 ;[240] INCREASE BLOCK, NO NEED TO INCREASE BUFFER
VECT1=DRMBUF+2 ;TEMP SPACE FOR MAT INVERT
VECT2=DRMBUF+312 ;[240] THIS ALLOWS MAT INV OF 201 X 201 (DECIMAL)
INVLIM: XWD 311,311 ;[240]LARGEST MATRIX TO INVERT
RENFLA: EXP -1 ;-1 ALLOWS REEN;0 PREVENTS REEN;>0 REQUESTS REEN
SAVEX1: BLOCK 1 ;[236]PLACE TO SAVE X1 DURING OFLO/UFLO PROCESSING.
;SYSTEM PARAMETERS.
BATCH: BLOCK 1 ;< > 0 IF UNDER MPB.
DSKSYS: BLOCK 1
MONLVL: BLOCK 1 ;DISTINGUISHES BETWEEN LEVEL C AND LEVEL D.
SWAPSS: BLOCK 1 ;0 FOR NON-SWAP SYS, -1 FOR SWAPPING.
SJOBSA: BLOCK 1 ;INITIAL LH OF .JBSA.
SJOBRL: BLOCK 1 ;INITIAL .JBREL
;END--SYSTEM PARAMETERS.
;COMMAND TIME.
COPFLG: BLOCK 1 ;COPFLG IS USED BY THE COPY ROUTINE.
HEDFLG: BLOCK 1 ;HEADING FLAG FOR QUEUE AND UNSAVE.
BADGNN: BLOCK 2
CURDEV: BLOCK 1 ;THE DEVICE ASSOCIATED WITH THE "CURRENT" FILE.
CURNAM: BLOCK 1 ;NAME OF THE "CURRENT" FILE.
CUREXT: BLOCK 1 ;ITS EXTENSION.
CURBAS: BLOCK 1 ;< > 0 SAYS CURRENT DEVICE IS FAKED BAS.
RETUR1: BLOCK 1
USGFLG: BLOCK 1 ;USED BY RES TO SEE IF # FOLLOWING USING IS LINE #.
OLDFLA: BLOCK 1 ;ZERO WHEN FILE NAME SHOULD BE NEW, ELSE -1.
RENSW: BLOCK 1
REVFL: BLOCK 1
LOWSTA: BLOCK 1
SEQPNT: BLOCK 1 ;POINTER TO LINBUF DURING RESEQUENCE.
LOWEST: BLOCK 1 ;RESEQUENCE LINES WITH NUMBERS >=LOWEST
PAKFLG: BLOCK 1 ;FLAG THAT TELLS IF CORE SHOULD BE CRUNCHED.
PAKFLA: BLOCK 1 ;-1 IF TEXT IS NOT PACKED
FRSTLN: BLOCK 1
LASTLN: BLOCK 1
FILNM: BLOCK 2
;END--COMMAND TIME.
;COMPILE AND LOAD TIME.
LOCLOF: BLOCK 1 ;USED BY XINFCN.
IFFLAG: BLOCK 1
FILCNT: BLOCK 1
LETSW: BLOCK 1
WRREFL: BLOCK 1 ;0 IF COMPILING PRINT#/INPUT#, -1 IF WRITE#/READ#.
TABLE: BLOCK 1
FUNAME: BLOCK 1 ;IF NZERO, NAME OF MULTI-LINE FN BEING DEFINED
RUNFLA: BLOCK 1 ;-1 IF COMPILE OR RUN
FUNSTA: BLOCK 1 ;RHALF HAS LOCATION OF JRST AROUND FUNCTION
;LHALF SAVES ARGUMENT COUNT IN A MULTILINE FN
FUNLOW: BLOCK 1 ;SAVE VALUE OF TMPLOW DURING MULTILINE FN
REGPNT: BLOCK 1 ;POINTER TO SUBEXP IN REG
TMPLOW: BLOCK 1 ;CURRENT TEMP UNPROTECTED. (-1 TO START)
TMPPNT: BLOCK 1 ;CURRENT TMP USED (-1 TO START)
PSHPNT: BLOCK 1 ;COUNTS GENNED "PUSH" INSTS
TRNFLG: BLOCK 1 ;USED TO HANDLE SETTING A
TRNFL2: BLOCK 1 ;MATRIX EQUAL TO ITS OWN TRANSPOSE.
;END--COMPILE AND LOAD TIME.
;EXECUTION TIME, INTRINSIC FUNCTIONS.
DETER: BLOCK 1 ;CONTAINS THE DETERMINATE OF LAST MAT INVERTED.
NUMRES: BLOCK 1 ;SET BY MAT INPUT TO NUMBER OF ELEMENTS INPUT.
MIDSAV: BLOCK 1 ;USED BY MIDB.
STRFCN: BLOCK 1 ;USED BY STRB.
STRPTR: BLOCK 1
STRCTR: BLOCK 1
VALPTR: BLOCK 1 ;USED BY VALB.
BGNTIM: BLOCK 1 ;STORAGE USED BY TIM.
FLOAT: BLOCK 1
RNDIDX: BLOCK 1 ;INDEX FOR RND FUNCTION.
RNDDAT: BLOCK 7 ;DATA LOCATIONS FOR RND FUNCTION.
RANTST: BLOCK 1
RANCNT: BLOCK 1
ELECT1: BLOCK 1 ;[207]UPPER BOUND OF COLUMN DIMENSION
ELECT2: BLOCK 1 ;[207]RUNNING COUNT OF PLACE IN COLUMNS
ELECT3: BLOCK 1 ;[207]VALUE IN ELECT2 AT START OF INPUT
;END--EXECUTION TIME, INTRINSIC FUNCTIONS.
;EXECUTION TIME, CORE MANAGER.
MASAPP: BLOCK ^D47
SRTDBA: BLOCK 9
BA: BLOCK 9
CORINC: BLOCK 1 ;INCREMENT FOR CORE DURING PROGRAM EXECUTION.
NUMMSP: BLOCK 1
NUMAPP: BLOCK 1
VRFBOT: BLOCK 1
VRFTOP: BLOCK 1
VRFBTB: BLOCK 1
VRFSET: BLOCK 1
;END--EXECUTION TIME, CORE MANAGER.
;EXECUTION TIME, MISC.
N=0
EX1: FSC N,0 ;SCALE THE RESULTS.
IFNFLG: BLOCK 1
EXTFG: BLOCK 1
SORCLN: BLOCK 1 ;AT EXECUTION TIME, THE CURRENT SOURCE LINE NO.
TRAIL: BLOCK 1 ;FLAGS FOR
LEAD: BLOCK 1 ;USING STATEMENTS.
INVFLG: BLOCK 1 ;NE 0 MEANS INVERTING A MATRIX.
INVLRG: BLOCK 1 ;DURING MAT INV HAS ELM OF LRGS MAG.
REATMP: BLOCK 1 ;USED BY STRETT AND STRETR.
SB1M1: BLOCK 1
SB2M1: BLOCK 1
INPFLA: BLOCK 1 ;NON-ZERO DURING INPUT,ZERO DURING READ
LIBFLG: BLOCK 1
DATLIN: BLOCK 2 ;DATA LINE
PREAD: BLOCK 2 ;POINTER TO DATA LINES
PINPUT: BLOCK 2 ;POINTER TO INPUT LINES
QUOFL1: BLOCK 1 ;-1 SAYS READING A QUOTED STRING.
QUOFLG: BLOCK 1 ;<>0 SAYS MUST QUOTE THIS STRING WHEN PRINTING.
ELETOP: BLOCK 1 ;UPPER BOUND OF "MAT INPUT"
;END--EXECUTION TIME, MISC.
;FORMAT AND FILE CONTROL.
PINPNM: BLOCK ^D9
LINNUM: BLOCK ^D9
TABVAL: BLOCK ^D10
POINT: BLOCK ^D9 ;USED BY THE R.A. ROUTINES.
BLOCK: BLOCK ^D9
MODBLK: BLOCK ^D9
STRLEN: BLOCK ^D9
LASREC: BLOCK ^D9
ZONFLG: BLOCK ^D10 ;USED TO FORCE COMMAS TO SPACE.
EOFFLG: BLOCK ^D9
FIRSFL: BLOCK ^D10 ;TELLS IF ANY OUTPUT HAS BEEN DONE ON THIS PAGE.
PROTEC: BLOCK ^D9 ;< > FOR FILES AT RUNTIME.
PAGCNT: BLOCK ^D10
PAGLIM: BLOCK ^D10
QUOTBL: BLOCK ^D10
PARAM: ;WARNING ********************************
WRIPRI: BLOCK ^D9 ;PARAM IS A ^D32 WORD BLOCK FOR USE BY QUEUE.
REAINP: BLOCK ^D9
MARGIN: BLOCK ^D10
MARWAI: BLOCK ^D10
FILD: BLOCK ^D9
EXTD: BLOCK ^D9
ACTBL: BLOCK ^D9
FMTPNT: BLOCK ^D10 ;LAST FORMAT CHAR FLAG
HPOS: BLOCK ^D10 ;HORIZ POSITION.
TTYPAG: BLOCK 1
IFIFG: BLOCK 1 ;INPUT FROM DSK (IF NOT ZERO).
ODF: BLOCK 1
;END--FORMAT AND FILE CONTROL.
;MISC.
NUMCOT: BLOCK 1 ;USED AT COMMAND AND RUNTIME TO ADJUST SEQ. NOS.
RUNLIN: BLOCK 1 ;HAS START LINE NO. FOR PROG EXEC OR -1 IF NONE.
MTIME: BLOCK 1 ;HOLDS TIME FOR "TIME:" MESSAGE.
;END--MISC.
;DISPATCH.
TRPLOC: XWD 4,TRPMSG
400000000002
BLOCK 2
STOTRP: BLOCK 1 ;TEMP USED FOR LOC AT CTRL C INTERP.
UUOH: BLOCK 1
JRST UUOHAN
;END--DISPATCH.
;IO.
SPEC: EXP 1
NEWOL1: SIXBIT /DSK/
EXP TYI
SAVI: OCT 1
SAVE1: SIXBIT /DSK/
XWD TYO,
IBF: BLOCK 3
OBF: BLOCK 3
FILDIR: BLOCK 6
FILD1: BLOCK 4
LOK: BLOCK 4
ENT: BLOCK 4
;[241]
;[241] Argument block for QUEER
;[241]
QUEBLK: ;[241]
1 ;[241]FUNCTION (PRINT FILE)
0 ;[241]NODE = LOCATED NODE
0 ;[241]RESPONSE
0B0 ! 11B17 ! 10B35 ;[241]FILE SPEC ARG BLOCK
FILBLK ;[241]FILE SPEC ADDRESS
1B0 ! 1B17 ! 11B35 ;[241]COPIES BLOCK
BLOCK 1 ;[241]NUMBER OF COPIES
1B0 ! 1B17 ! 14B35 ;[241]DISPOSITION BLOCK
BLOCK 1 ;[241]0=PRESERVE 1=DELETE
1B0 ! 1B17 ! 17B35 ;[241]PAGE LIMIT BLOCK
BLOCK 1 ;[241]NUMBER OF PAGES
QUELEN=.-QUEBLK ;[241]
FILBLK: ;[241]
SIXBIT /DSK/ ;[241]
BLOCK 2 ;[241]FILE NAME AND EXTENTION
BLOCK 6 ;[241]PPN AND SFD'S
PTHBLK: BLOCK ^D9 ;[234]PATH BLOCK,ROOM FOR 5 SFD'S
TYI: BLOCK 3
TYO: BLOCK 3
TTYBUF: BLOCK 46
LINB0: BLOCK ^D29
APPMAX=^D100 ;[224] MAXIMUN NUMBER OF APPEND BLOCKS
APPLST: ;APPLST IS RUNTIME, QLSPEC IS COMMAND TIME.
;**;[243] @ QLSPEC CHANGE 1 LINE, MRB, 31-AUG-81
QLSPEC: BLOCK APPMAX+1;[224]MAY KEEP MENY APPEND BLOCKS ARROUND
;[224]WHILE EXECUTING USER DEFINED FUNCTIONS.
OBDSK2: OUTBUF 0,2
OBDSK: OUTBUF 0,1
IBDSK2: INBUF 0,2
IBDSK: INBUF 0,1
OUTDSK: OUTPUT 0,
OUTTDS: OUT 0,
INDSK: INPUT 0,
INNDSK: IN 0,
STODSK: STATO 0,740000
STADSK: STATZ 0,20000
STWDSK: STATZ 0,400000
STQDSK: STATZ 0,040000
GTSTS: GETSTS 0,N
CLOSED: CLOSE 0,
RENAMD: RENAME 0,LOK
CURLIN: BLOCK 1
DREL: RELEASE 0,
LOKUP: LOOKUP 0,LOK
ENTDSK: ENTER 0,ENT
DEFINE R(A)
< IRP A
< USETO A,0>>
USETOD: R<1,2,3,4,5,6,7,8,9>
DEFINE R(A)
< IRP A
< USETI A,0>>
USETID: R<1,2,3,4,5,6,7,8,9>
DEFINE R(A)
< IRP A
< OPEN ^D<A>,OPS'A>>
INITO: R<1,2,3,4,5,6,7,8,9>
DEFINE R(A)
<IRP A
<OPS'A: OCT 1
SIXBIT /DSK/
XWD DO'A,DI'A
INTERN OPS'A>>
R<1,2,3,4,5,6,7,8,9>
DEFINE R(A)
< IRP A
<LINB'A: BLOCK ^D29
INTERN LINB'A >>
R<1,2,3,4,5,6,7,8,9>
DEFINE R(A)
< IRP A
<DO'A: BLOCK 3
DI'A: BLOCK 3
INTERN DO'A,DI'A >>
R<1,2,3,4,5,6,7,8,9>
;END--IO.
;PUSHDOWN LISTS.
PLIST: XWD -300,.
BLOCK 300
QLIST: XWD -100,.
BLOCK 100
;END--PUSHDOWN LISTS.
;ROLLS.
DEFINE ROLLS <
X TXT
X LIN
X COD
X CON
X SLT
X LIT
X ARA
X SVR
X GSB
X SCA
X VSP
X PTM
X TMP
X STM
X VAR
X SEX
X ARG
X REF
X FCN
X FCL
X FAD
X CAD
X LAD
X SAD
X FOR
X NXT
>
PSHROL=200000 ;ADDRESS ASSOCIATED WITH THIS
;PHANTOM ROLL ARE ABSOLUTE, INDEXED BY (P)
DEFINE TBLS<
X CMD
X STA
X DEC
X REL
>
ZZ.=0
DEFINE X(A)
<A'ROL=ZZ.
ZZ.=ZZ.+1
>
TBLS
ROLLS
ROLTOP=ZZ.-1
FLOOR:
DEFINE X(A)
<EXP A'FLO>
TBLS
DEFINE X(A)
<Z>
ROLLS
CEIL:
DEFINE X(A)
<EXP A'CEI>
TBLS
DEFINE X(A)
<Z>
ROLLS
COMBOT=VARROL ;BOTTOM COMPILE ROLL AFTER CODROL
COMTOP=NXTROL ;TOP COMPILE ROLL.
MINFLG=400000 ;MINUS FLAG IN LEFT HALF OF EXPR PNTR
ROLMSK=377777 ;ROLL NUMBER MASK IN SAME
SUBTTL LITERALS
DEFINE IMP(A)
< CE'A=CEIL+A'ROL
FL'A=FLOOR+A'ROL
INTERN CE'A,FL'A >
IMP SVR
IMP SLT
IMP LIT
IMP SCA
IMP ARA
IMP STM
IMP PTM
IMP LAD
IMP GSB
IMP FOR
IMP FCL
IMP CAD
IMP ARG
IMP REF
IMP COD
IMP SEX
IMP SAD
IMP NXT
IMP LIN
IMP CON
IMP VSP
IMP TXT
IMP TMP
;END--ROLLS.
END