Trailing-Edge
-
PDP-10 Archives
-
decuslib10-04
-
43,50326/abacus.new
There are no other files named abacus.new in the archive.
TITLE ABACUS - ADVANCED BOWDOIN ARITHMETIC CALCULATOR UTILITY SYSTEM
SUBTTL DECLARATIONS
;WRITTEN BY WILLIAM E. SEVERANCE, JR. '74
;WITH SPECIAL CREDIT TO PAUL P. VAGNOZZI '75 FOR ASSISTANCE IN
;DEVELOPING THE PNS CONVERSION AND FUNCTION CALLING TECHNIQUES
;WITHOUT WHICH ABACUS WOULD BE IMPOSSIBLE
;DEVELOPMENT OF ABACUS BEGAN IN THE SPRING OF 1972 AS A FUTURE
;SUBSTITUTE FOR THE SYSTEM PROGRAM "AID".
;*********INSTRUCTIONS FOR LOADING AND SAVING ABACUS***********
;THE ABACUS SYSTEM IS SUPPLIED WITH THE FOLLOWING FILES:
; ABACUS.MAC -- SOURCE CODE IN MACRO-10
; ABACUS.SHR -- SHARABLE OBJECT CODE WITH STANDARD ASSEMBLY PARAMETERS
; ABACUS.HLP -- ASCII HELP FILE TO BE PLACED ON DEVICE SYS:
; ABACUS.STO -- SAMPLE STORAGE FILE PRODUCED BY ABACUS
; CONTAINING MANY USEFUL FUNCTION DEFINITIONS
;TO LOAD YOUR OWN ABACUS SYSTEM THE FOLLOWING IS TYPED:
; .LOAD ABACUS.MAC
;TO MAKE A SHARABLE VERSION OF ABACUS SIMPLY TYPE:
; .SSAVE SYS:
;*******************************************************************
IFNDEF PURE,<PURE=1> ;TWO SEGMENT IF PURE=1
IFN PURE,<TWOSEG>
IFN PURE,<RELOC 400000>
;ACCUMULATOR ASSIGNMENTS
FLAGS=0 ;SEE HOW THEY WAVE BELOW
A=1 ;GENERAL PURPOSE
B=2
C=3
D=4
N=5 ;FOR NUMBERS
N1=N+1 ;NEXT TO N THERE'S N1
CNT=7 ;ALL PURPOSE COUNTER
FIND=10 ;FUNCTION INDEX
PIND=11 ;PNS INDEX
SYMBOL=12 ;FOR LABLES, ETC.
WD=13 ;FOR WORDS
CHR=14 ;FOR CHARACTERS (XWD FLAG,SIXBIT CHARACTER)
BPT=15 ;A BYTE POINTER
STACK=16 ;STACK PUSH DOWN POINTER
PDP=17 ;REGULAR PUSH DOWN POINTER
;FLAGS IN RIGHT HALF OF 'FLAGS'
F.LPAR=1 ;LAST ELEMENT WAS "("
F.LVAR=2 ;LAST ELEMENT WAS NUMBER OR LABLE
F.LOPP=4 ;LAST ELEMENT WAS AN OPERATOR
F.PASS=10 ;A DEFINITION IS BEING PASSED
F.DEFN=20 ;A FUNCTION IS BEING DEFINED
F.DTA=40 ;DEVICE IS A DTA
F.MINI=200 ;ON IF MINUS DO INCREMENT
F.DEG=400 ;ON IF TRIG FUNCTIONS WORK IN DEGREES
F.MINV=1000 ;IT'S A MINUS VALUE
F.UNDR=2000 ;UNDERFLOW HAS OCCURED
F.OVER=4000 ;OVERFLOW HAS OCCURRED
F.FCHR=10000 ;ON IF OUTPUTING TO A FILE
F.ALF=20000 ;ON IF COMMAND ARG 'ALLFUN' SEEN
F.ALV=40000 ;ON IF COMMAND ARG 'ALLVAR' SEEN
F.VARS=100000 ;ON IF A VARIABLE SEEN IN INPUT FILE
F.FUNS=200000 ;ON IF A FUNCTION SEEN IN INPUT FILE
;FLAGS IN LEFT HALF OF 'FLAGS'
F.NUM=1 ;A DIGIT HAS BEEN SEEN
F.MINN=2 ;IT'S A MINUS QUANTITY
F.DOT=4 ;A DOT HAS BEEN SEEN
;CHARACTER FLAGS IN LEFT HALF OF AC "CHR"
C.OTHR=0 ;NOT HANDLED WITH FLAGS
C.ILEG=1 ;ILLEGAL CHARACTER
C.LETT=2 ;A LETTER
C.LOWC=4 ;LOWER CASE
C.DIGI=10 ;A DIGIT
C.DOT=20 ;A DECIMAL POINT
C.COLN=40 ;A COLON
C.CR=100 ;CARRIAGE RETURN
C.LTR=200 ;THE LESS THAN RELATION <
C.GTR=400 ;THE GREATER THAN RELATION >
C.SPAC=1000 ;A SPACE
C.COMA=2000 ;A COMMA
C.SEMI=4000 ;A SEMI COLON
C.OPR=10000 ;AN OPERATOR
C.EQAL=20000 ;THE EQUAL SIGN
C.LPAR=40000 ;LEFT PARENTHESIS
C.RPAR=100000 ;RIGHT PARENTHESIS
C.LBRK=200000 ;A LEFT BRACKET
C.RBRK=400000 ;A RIGHT BRACKET
C.LETL=C.LETT+C.LOWC ;LOWER CASE LETTER
C.TERM=C.SEMI+C.CR ;EXPRESSION TERMINATOR
;DEVCHR CALLI BIT FLAGS -- IN AC "A" AFTER DEVCHK ROUTINE
DV.DSK=200000 ;DEVICE IS DSK
DV.LPT=40000 ;DEVICE IS LPT
DV.DTA=100 ;DEVICE IS DECTAPE
DV.AVL=40 ;DEVICE IS AVAILABLE TO JOB
DV.TTY=10 ;DEVICE IS A TTY
DV.DIR=4 ;DEVICE IS A DIRECTORY DEVICE (DSK OR DTA)
DV.IN=2 ;DEVICE CAN DO INPUT
DV.OUT=1 ;DEVICE CAN DO OUTPUT
;MISC. DEFINITIONS
PNSLEN=^D256 ;PNS MAXIMUM LENGTH
STKLEN=^D150 ;STACK MAXIMUM PDL DEPTH
PDLLEN=^D32 ;REGULAR PDL MAXIMUM DEPTH
.JBVER=137 ;VERSION NUMBER LOCATION
LTLEN=^D128 ;MAXIMUM LENGTH OF LABTAB (EACH ENTRY IS 2 WORDS)
MAXARG=^D10 ;MAXIMUN NUMBER OF FUNCTION ARGS
OPFLD=10 ;OPCODE FIELD FOR UUO'S
STDPRO=157000 ;STANDARD OUTPUT FILE PROTECTION
MODE=14 ;BINARY MODE FOR FILE INPUT/OUTPUT
ASCMOD=0 ;ASCII MODE
FILCOD=234500 ;FILE FORMAT CODE
;ASCII CHARACTER CODES
TAB=11 ;TAB
LF=12 ;LINE FEED
CR=15 ;CARRIAGE RETURN
SPACE=40 ;SPACE
;I/O CHANNEL ASSIGNMENTS
CHANI=1 ;INPUT FROM FILE
CHANO=2 ;OUTPUT TO FILE
;CONDITIONAL ASSEMBLY SWITCHES
IFNDEF HEADER,<HEADER=1> ;PRINT GREATING IF 1
IFNDEF DEBUG,<DEBUG=0> ;DEBUG FEATURES IF 1
IFNDEF FILCAP,<FILCAP=1> ;FILE CAPABILITIES IF 1
IFNDEF BYER,<BYER=1> ;ALLOW LOGOUTS IF 1
;EXTERNAL DECLARATIONS
EXTERN .JBSA,.JBFF,.JBREL,.JBTPC,.JBAPR,.JBUUO,.JB41,.JBDDT,.JBREN
;UUO OPCODE DEFINITIONS -- SEE ROUTINE UUOH FOR DETAILS
OPDEF SPEAK [1B8]
OPDEF ERR [2B8]
OPDEF ERRF [3B8]
LOC .JBVER ;SET UP VERSION NUMBER
XWD 1,4
RELOC
SUBTTL MAIN PROGRAM
ABACUS: CALLI 0 ;RESET ALL I/O
SETZ FLAGS, ;ZERO ALL FLAGS
MOVE A,[LOWBEG,,LOWBEG+1] ;SET UP BLT WORD TO CLEAR
SETZM LOWBEG ;ALL OF THE LOW SEGMENT
BLT A,LOWEND-1
SETZ A, ;SAVE RUN TIME THUS FAR
CALLI A,27
MOVEM A,INRNTM
CALLI A,23 ;SAVE STARTING TIME
MOVEM A,INCNTM
HRLZI A,CNT ;SET UP FUNCTION POINTER
HRR A,.JBFF
MOVEM A,FNSTPT
HRRZM A,FUNNXT ;SET UP ADR FOR NEXT FUNCTION
MOVEI A,FIND ;SET UP SECOND FUNCTION POINTER
HRLZM A,FUNPNT
MOVE A,.JBREL ;SET UP MAX ADR OF LOW SEG
HRRZM A,FUNMAX
MOVEI A,PIND ;SET UP PNS POINTER
HRLZM A,PNSLOC
MOVE A,[FSC N,0] ;SET UP CONSTANT LOCS IN LOW SEG
MOVEM A,EX1
MOVEI A,2 ;2 VARIABLES ARE PRE-DEFINED
MOVEM A,LABTOT
MOVE A,[SIXBIT /RESLT/]
MOVEM A,LABTAB
MOVE A,[SIXBIT /TOT/]
MOVEM A,LABTAB+2
MOVE A,[PUSHJ PDP,UUOH] ;GET READY FOR UUO TRAPPING
MOVEM A,.JB41
MOVEI A,TRAPIT ;SET UP PROCESSOR TRAPPING
HRRZM A,.JBAPR ;FOR REPETATIVE ENABLE
MOVEI A,600110 ;OF PDL OVERFLOW AND
CALLI A,16 ;ARITH. OVER/UNDERFLOW
MOVE PDP,PDLPNT ;INIT REGULAR PUSH DOWN LIST
MOVEI A,RENTER ;SET UP REENTER LOCATION
MOVEM A,.JBREN
IFN FILCAP,<
PUSHJ PDP,DTAFIL ;SET UP A TMP FILENAME
>
PUSHJ PDP,CRLF ;FANCY IT UP
IFN HEADER, <
SPEAK HDMSG ;PRINT GREATING
HLRZ N,.JBVER ;PUT OUT VERSION NUMBER
PUSHJ PDP,OCTPNT
PUSHJ PDP,PERIOD
HRRZ N,.JBVER
PUSHJ PDP,OCTPNT
PUSHJ PDP,TABOUT
PUSHJ PDP,DATE ;ALONG WITH DATE AND TIME
PUSHJ PDP,TABOUT
PUSHJ PDP,TIME
PUSHJ PDP,CRLF
> ;END OF COND. ON HEADER
BEGINC: PUSHJ PDP,CRLF
;THIS IS THE TOP LEVEL OF ABACUS!!!!!
BEGIN: TLNN CHR,C.SEMI ;SEMICOLON WAS TERMINATIOR?
RENTER: PUSHJ PDP,PROMPT ;PUT OUT A "#"
MOVSI PIND,-PNSLEN ;SET UP PNS LENGTH CONTROL
SETZ FLAGS, ;CLEAR ALL FLAGS
SETZM VARNAM ;VARIABLE NAME ON AN EQUAL
MOVE STACK,STKST ;INIT STACK AS A DELIMITER LIST
PUSHJ PDP,SSPACE ;INPUT SKIPING SPACES
TLNE CHR,C.TERM ;ANYTHING TYPED?
JRST BEGIN ;HOW SAD. . .
TLNE CHR,C.LETT ;ALPHA?
JRST BEGINA
TLNE CHR,C.DIGI+C.DOT ;NUMERIC?
JRST BEGINN
PUSHJ PDP,POLC3 ;START SCAN WITH SOMETHING ELSE
CHAIN: MOVE STACK,STKST ;COME HERE WHEN CHAINING
PUSH STACK,RESLT ;PUSH PREVIOUS RESLT ONTO STACK
PUSHJ PDP,PNSVAL ;EVALUATE PNS
MOVE N,RESLT ;UPDATE THE BACKUP RESLT
MOVEM N,BRESLT
POP STACK,RESLT ;AND STORE THE RESULT
JRST BEGIN ;START FRESH
BEGINA: MOVEI CNT,6 ;HERE ON FIRST ALPHA
PUSHJ PDP,LABIN ;BRING IN LABLE OR COMMAND
JRST LABLON ;TOO MANY CHARACTERS
PUSHJ PDP,COMCHK
JRST @COMTAB+1(A) ;GO TO THE COMMAND ROUTINE
BEGIN1: TLNE CHR,C.LETT+C.DIGI+C.DOT
ERR NOCOMD ;COMMAND IS BAD
CAIGE CNT,1 ;HERE IF NOT LEGAL COMMAND
JRST LABLON ;TOO LONG A VARIABLE
TLNE CHR,C.EQAL ;AN EQUAL SIGN?
JRST TYPE1 ;YES, TREAT AS IMPLICIT TYPE
PUSH STACK,.PLUS ;PLACE PLUS CODE INTO DL
PUSHJ PDP,POLC4 ;TREAT AS A LABLE TO START PNS CONVERSION
JRST CHAIN ;THEN CHAIN
BEGINN: PUSH STACK,.PLUS ;HERE IF NUMBER
PUSHJ PDP,POLC2 ;START SCAN WITH NUMBER
JRST CHAIN ;AND LIKEWISE CHAIN
SUBTTL COMMAND HANDLING ROUTINES
;THE FOLLOWING ROUTINES HANDLE THE MAJORITY OF ABACUS
;COMMANDS AND ARE DISPATCHED TO VIA THE COMMAND TABLE COMTAB
;THE TYPE COMMAND
;THE FORMAT IS AS FOLLOWS:
; TYPE NUMERICAL EXPRESSION
TYPE: TLNN CHR,C.LETT ;LETTER?
JRST TYPE2
MOVEI CNT,5
PUSHJ PDP,LABIN ;GET IN THE LABLE
JRST LABLON
TLNE CHR,C.EQAL ;EQUAL SIGN?
TYPE1: MOVEM SYMBOL,VARNAM ;SAVE THE NAME
PUSHJ PDP,POLC4 ;START PNS CONVERSION
JRST TYPO ;TYPE OUT THE RESULTS
TYPE2: TRO FLAGS,F.LPAR ;ALLOW NEGATION
PUSHJ PDP,POLC1 ;START PNS CONVERSION
TYPO: MOVE STACK,STKST ;INITIALIZE THE STACK
PUSHJ PDP,PNSVAL ;EVALUATE THE PNS
MOVE SYMBOL,VARNAM ;GET VARIABLE NAME ON EQUAL
POP STACK,N ;GET FINAL RESULT FROM STACK
PUSHJ PDP,TABOUT ;PRINT TAB
PUSHJ PDP,SIXOUT ;PRINT LABLE (IF ANY)
PUSHJ PDP,EQOUT ;PRINT EQUAL SIGN
PUSHJ PDP,FLOCON ;PRINT THE NUMERIC VALUE
PUSHJ PDP,CRLF2
JRST BEGIN
;THE FOR COMMAND
;THE FORMAT IS AS FOLLOWS:
; FOR VALUE=START,END,INCREMENT DO NUMERICAL EXPRESSION
FOR: TRZ FLAGS,F.MINI ;CLEAR NEG. INCREMENT FLAG
TLNE CHR,C.TERM ;ANYTHING TYPED?
ERR FORLET ;MUST BEGIN WITH A LETTER?
TLNN CHR,C.LETT ;LETTER?
ERR FORLET
MOVEI CNT,5 ;5 CHR MAX
PUSHJ PDP,LABIN ;GET THE LABLE
JRST LABLON ;TOO MANY CHARACTERS
MOVEM SYMBOL,FORVAR ;SAVE IT
TLNN CHR,C.EQAL ;EQUAL SIGN?
ERR FOREQ ;NO
PUSHJ PDP,GETVAL ;GET START VALUE
MOVEM N,DOREG1 ;AND SAVE IT
TLNN CHR,C.COMA ;COMMA NEXT?
ERR BADST ;NO
PUSHJ PDP,GETVAL ;GET END VALUE
MOVEM N,DOREG2 ;AND SAVE IT
MOVE N,ONE ;DEFAULT INCREMENT
TLNN CHR,C.COMA ;COMMA IF INCREMENT FOLLOWS
JRST FOR1 ;DEFAULT OF 1.0
PUSHJ PDP,GETVAL
FOR1: MOVEM N,DOREG3 ;AND SAVE IT
JUMPN N,.+2 ;ZERO INCREMENT BAD
ERR ZERINC
MOVE N1,DOREG1 ;GET START AGAIN
JUMPL N,.+4 ;NEG. INCREMENT?
CAMLE N1,DOREG2 ;NO
ERR ENDLST
JRST .+4
TRO FLAGS,F.MINI ;NOTE THE NEG. INCREMENT
CAMGE N1,DOREG2
ERR STLEND
MOVEI CNT,2 ;2 CHRS IN 'DO'
TLNE CHR,C.LETT
PUSHJ PDP,LABIN ;PICK UP 'DO'
ERR NODO
CAME SYMBOL,[SIXBIT /DO/] ;'DO' MUST FOLLOW
ERR NODO
TRO FLAGS,F.LPAR ;SET TO ALLOW NEGATION
PUSHJ PDP,POLCON+1 ;FULL SCAN
MOVE SYMBOL,FORVAR
LSH SYMBOL,-6 ;MAKE OPCODE OPDC
IOR SYMBOL,.OPDC
SETZ PIND,
MOVE A,.DONE ;DONE SCAN WHEN .DONE IS SEEN
MOVE B,.DOCAL ;WHAT WE SUBSTITUTE FOR OPDC'S
FOR2: CAMN A,PNS(PIND) ;SEARCH AND ALTER PNS
JRST FOR3 ;DONE
CAME SYMBOL,PNS(PIND)
AOJA PIND,FOR2 ;NOT THIS ONE
MOVEM B,PNS(PIND) ;SUBSTITUTE DOCALL
AOJA PIND,FOR2 ;LOOP THROUGH
FOR3: PUSHJ PDP,CRLF
PUSHJ PDP,TABOUT
MOVE SYMBOL,FORVAR ;GET FOR VARIABLE
PUSHJ PDP,SIXOUT ;AND PRINT IT
PUSHJ PDP,TABOUT
SPEAK [ASCIZ /VALUE/]
PUSHJ PDP,CRLF2
FOR4: MOVE STACK,STKST ;SET UP STACK
PUSHJ PDP,PNSVAL ;EVALUATE PNS
MOVE N,DOREG1 ;GET CURRENT VALUE
PUSHJ PDP,TABOUT
PUSHJ PDP,FLOCON ;PRINT IT
PUSHJ PDP,TABOUT
POP STACK,N ;GET RESULT OF CALCULATION
PUSHJ PDP,FLOCON ;PRINT IT
PUSHJ PDP,CRLF
MOVE N,DOREG1 ;GET COUNT
FADR N,DOREG3 ;ADD ON INCREMENT
CAMN N,DOREG1 ;ANY CHANGE?
ERR NOCNG
MOVEM N,DOREG1 ;SAVE THE UPDATE
TRNN FLAGS,F.MINI ;MINUS INCREMENT
JRST .+4 ;YES
CAMGE N,DOREG2 ;CHECK FOR END
JRST BEGINC
JRST FOR4
CAMLE N,DOREG2
JRST BEGINC
JRST FOR4
;THE DAYTIM COMMAND -- PRINTS THE DATE AND TIME
DAYTIM: TLNN CHR,C.TERM
ERR SINGLE
PUSHJ PDP,DATIM
JRST BEGINC
;THE RUNTIM COMMAND -- PRINTS USER'S RUNTIME IN SECONDS
RNTIM: TLNN CHR,C.TERM
ERR SINGLE
PUSHJ PDP,RNTIME
PUSHJ PDP,CRLF
JRST BEGINC
;THE CONTIM COMMAND -- PRINTS ELAPSED TIME SINCE STARTUP OF ABACUS
CONTIM: TLNN CHR,C.TERM
ERR SINGLE
PUSHJ PDP,CNTIME
PUSHJ PDP,CRLF
JRST BEGINC
;THE PJOB COMMAND -- PRINTS USER'S JOB NUMBER
PJOBER: TLNN CHR,C.TERM
ERR SINGLE
CALLI N,30
SPEAK JOBMSG
JRST BEGINC
;THE DISPLY OR DIS COMMAND -- DISPLAYS RESULT OF CHAIN CALCULATION
DISPLY: TLNN CHR,C.TERM ;MUST BE TERMINATED
ERR SINGLE
MOVE N,RESLT
SPEAK DISMSG
JRST BEGINC
;THE SUBTOT OR S COMMAND -- TAKES A SUBTOTAL
SUBTOT: TLNN CHR,C.TERM ;MUST BE TERMINATED
ERR SINGLE
MOVE N1,TOT
MOVE N,RESLT
FADRM N,TOT ;ADD ONTO COMBINED TOTAL IN 'TOT'
TRZE FLAGS,F.UNDR ;MUST CHECK UNDER/OVER FLOWS
ERR SUBUND
TRZE FLAGS,F.OVER
ERR SUBOVR
MOVEM N1,BTOT ;UPDATE BACKUP TOTAL
SETZM RESLT ;CLEAR 'RESLT'
SPEAK SUBMSG
JRST BEGINC
;THE TOTAL OR T COMMAND -- DOES A TOTAL
TOTAL: TLNN CHR,C.TERM
ERR SINGLE
MOVE N,RESLT
FADR N,TOT ;FORCE A SUBTOTAL FIRST
TRZE FLAGS,F.UNDR ;CHECK FOR UNDER/OVER FLOWS
ERR SUBUND
TRZE FLAGS,F.OVER
ERR SUBOVR
SETZM RESLT ;CLEAR 'RESLT' AND 'TOT'
SETZM TOT
SPEAK TOTMSG
JRST BEGINC
;THE CLRTOT COMMAND -- CLEARS 'TOT'
CLRTOT: TLNN CHR,C.TERM
ERR SINGLE
SETZM TOT
SPEAK CLRTMG
JRST BEGINC
;THE CLRSUB COMMAND -- CLEARS 'RESLT'
CLRSUB: TLNN CHR,C.TERM
ERR SINGLE
SETZM RESLT
SPEAK CLRSMG
JRST BEGINC
;THE BACKUP OR BK COMMAND -- BACKUPS OVER LAST LINE IN CHAIN
;CALCULATIONS
BACKUP: TLNN CHR,C.TERM
ERR SINGLE
MOVE N,BRESLT ;GET BACKUP RESULT INTO 'RESLT'
MOVEM N,RESLT
MOVE N,BTOT ;GET BACKUP TOTAL INTO 'TOT'
MOVEM N,TOT
SPEAK BAKMSG
JRST BEGINC
;THE CNGSGN OR CS COMMAND -- CHANGES SIGN OF 'RESLT'
CNGSGN: TLNN CHR,C.TERM
ERR SINGLE
MOVNS RESLT ;NEGATE 'RESLT'
SPEAK CNGMSG
JRST BEGINC
;THE STOP COMMAND -- EXITS TO MONITOR
STOP: TLNN CHR,C.TERM
ERR SINGLE
TTCALL 11, ;CLEAR INPUT BUFFER
CALLI 1,12 ;EXIT, BUT DON'T PRINT "EXIT"
SPEAK NOCONT ;DON'T LET THEM CONTINUE
JRST STOP
;THE BYE COMMAND -- PERFORMS A K/F LOGOUT
IFN BYER,<
BYE: TLNN CHR,C.TERM
ERR SINGLE
TTCALL 11,
MOVE A,[XWD 17,11] ;GET THE STATES WORD
CALLI A,41
JRST .+1
TLNN A,(1B2) ;IS IT A LOGIN SYSTEM?
ERR NOLOGO
MOVSI A,(SIXBIT /SYS/) ;SETUP RUNBLOCK BEGINNING AT FILNAM
MOVEM A,FILNAM
MOVE A,[SIXBIT /LOGOUT/]
MOVEM A,FILNAM+1
SETZM FILNAM+2
SETZM FILNAM+3
SETZM FILNAM+4
SETZM FILNAM+5
MOVSI A,1 ;OFFSET FOR STARTING LOC
HRRI A,FILNAM ;ADR OF RUN DATA BLOCK
CALLI A,35 ;THE RUN UUO
SPEAK NOLOGO ;CAN'T LOG OUT
JRST STOP ;PERFORM REGULAR STOP
>
;THE DEFINE OR DEF COMMAND
;THE FORMAT IS:
; DEFINE NAME(ARG1,ARG2,. . .,ARGN)=NUMERICAL EXPRESSION
DEFINF: TLNN CHR,C.LETT ;MUST BEGIN WITH A LETTER
ERR BADFLT
MOVEI CNT,5 ;ONLY 5 CHRS IN NAME
PUSHJ PDP,LABIN ;GET THE LABLE
JRST LABLON
SETZ FIND, ;ZERO INDEX TO FUNCTION TABLE
MOVEM SYMBOL,@FUNNXT ;STORE FUNCTION NAME
TRO FLAGS,F.DEFN ;TURN ON DEFINE FLAG
AOS A,FUNNXT ;SET FUNNXT TO HEADER+1
HRRM A,FUNPNT ;SET UP BASE ADR OF FUNPNT
PUSHJ PDP,CHKCOR ;CHECK CORE AVAILABLE
MOVE C,SRCPNT ;USE AC 'C' AS BPT TO SOURCE
SETZ WD, ;FOR EACH WORD OF SOURCE
SETZM NARGS ;NUMBER OF ARGUMENTS
PUSHJ PDP,STOSRC ;STORE NEXT CHR BEYOND NAME
TLNN CHR,C.LPAR
ERR BADDUM
HRLZI B,-MAXARG ;SET UP MAXIMUM ARGS CONTROL
DEFIN1: PUSHJ PDP,SSPACE ;GET NEXT NON-BLANK CHARACTER
TLNN CHR,C.LETT
ERR BADDLT
MOVEI CNT,5 ;GET AN ARGUMENT
PUSHJ PDP,LABIN
JRST LABLON
MOVEM SYMBOL,DUMARG(B) ;MAKE A TABLE OF DUMMY ARGS
AOBJN B,.+3
MOVEI N,MAXARG ;GET MAXIMUM NUMBER ALLOWED
ERR TOOMAG ;TOO MANY ARGUMENTS SUPPLIED
TLNE CHR,C.COMA ;ARGUMENTS ARE DELIMITED BY COMMAS
JRST DEFIN1
TLNN CHR,C.RPAR ;MUST END WITH A ")" OR ELSE
ERR BADARG ;BAD ARGUMENT DELIMITER
PUSHJ PDP,SSPACE ;GET NEXT NON-BLANK CHARACTER
TLNN CHR,C.EQAL ;MUST BE AN "=" OR ELSE
ERR BADFEQ ;MISPLACED EQUAL SIGN
HRRZM B,NARGS
TRO FLAGS,F.LPAR
PUSHJ PDP,POLCON
JUMPE WD,.+4 ;LAST WORD OF SOURCE TO STORE?
AOBJN FIND,.+2
PUSHJ PDP,CHKCOR
MOVEM WD,@FUNPNT ;STORE IT IF THERE IS
HRLZM FIND,@FUNNXT ;NUMBER OF SOURCE WORDS
MOVE A,NARGS ;NUMBER OF ARGUMENTS
DPB A,[POINT 6,@FUNNXT,5]
AOJ PIND, ;ADVANCE INDEX VALUE TO PNS
HRRM PIND,@FUNNXT ;NBER OF PNS WORDS
ADDI PIND,(FIND) ;SUM OF THE TWO
AOJ FIND,
MOVEI A,@FUNPNT ;ADR OF 1 WORD BEYOND SOURCE
HRLI A,PNS ;ADR OF PNS
MOVE FIND,PIND
PUSHJ PDP,CHKCOR ;ROOM FOR THE PNS?
BLT A,@FUNPNT ;BLT PNS INTO FUNCTION DEF
AOBJN FIND,.+2
PUSHJ PDP,CHKCOR
MOVEI B,@FUNPNT ;ADR OF NEXT FUNCTION
PUSH PDP,B ;SAVE AC 'B'
TRZ FLAGS,F.DEFN ;TURN OFF THE DEFINE FLAG
SOS FUNNXT ;SET TO POINT BACK TO NAME
DEFIN2: MOVE SYMBOL,@FUNNXT ;GET THE NAME AGAIN
PUSHJ PDP,RESCHK ;CHECKRFOR RESERVED WORDS
JRST DEFIN3 ;OH-OH!
POP PDP,FUNNXT ;FINALLY UPDATE FUNNXT
SPEAK DEFFUN
JRST BEGINC ;DONE WITH THE DEFINITION
DEFIN3: TTCALL 11,
SPEAK RENMSG ;LET THEM RENAME OR DELETE
PUSHJ PDP,SSPACE
TLNE CHR,C.CR ;A <CR>?
ERR ;FORGET THE DEFINITION
TLNN CHR,C.LETT
JRST DEFIN4 ;IMPROPER FUNCTION NAME
MOVEI CNT,5
PUSHJ PDP,LABIN
JRST LABLON
TLNN CHR,C.CR
JRST DEFIN4
MOVEM SYMBOL,@FUNNXT
JRST DEFIN2
DEFIN4: SPEAK BADFNM ;BAD FUNCTION NAME
JRST DEFIN3 ;LET THEM TRY AGAIN
;THE LIST AND PRINT COMMANDS
;THE FORMATS ARE:
; PRINT ARG1,ARG2,...,ARGN
; LIST ARG1,ARG2,...,ARGN
; PRINT ARG1,ARG2,...,ARGN ON DEV:FILNAM.EXT [PROJ,PROG]
; LIST ARG1,ARG2,...,ARGN ON DEV:FILNAM.EXT [PROJ,PROG]
IFN FILCAP,<
LISTER: TRO FLAGS,F.FCHR ;SET OUTPUT TO FILE (LPT)
SETZ A,
MOVSI B,(SIXBIT /LPT/) ;DEVICE IS LPT
MOVEM B,OPENBK+1
MOVE B,CUSP ;FILNAME IS ABACUS
MOVEM B,FILDAT
MOVSI B,(SIXBIT /LPT/) ;EXTENSION IS LPT
MOVEM B,FILDAT+1
SETZM FILDAT+2
SETZM FILDAT+3
MOVEI B,ASCMOD ;MODE IS ASCII
PUSHJ PDP,OPENO+1 ;OPEN DEVICE AND ENTER FILE
MOVEI B,203*2 ;GET THIS MUCH BUFFER SPACE
PUSHJ PDP,MDOWN
> ;END OF COND. ON FILCAP
PRINT: PUSHJ PDP,GETARG ;GET THE ARGS
ERRF NOARGS ;NONE TYPED
TLNN CHR,C.TERM ;DID THEY TERMINATE THE LINE RIGHT?
JRST PRINT4 ;HANDLE THE 'ON' FOR FILES
SETZ PIND, ;ZERO AN INDEX TO DUMARG
TRNE FLAGS,F.ALV ;PRINT ALL VARIABLES?
PUSHJ PDP,PRTALV ;YES
TRNE FLAGS,F.ALF ;PRINT ALL FUNCTIONS?
PUSHJ PDP,PRTALF ;YES
PUSHJ PDP,CRLF
PRINT1: SKIPN SYMBOL,DUMARG(PIND) ;GET AN ARGUMENT
JRST PRT3A ;DONE WHEN NULL
PUSHJ PDP,LABCHK ;LOOK UP AS A VARIABLE
JRST PRINT2 ;NOT FOUND
TRNE FLAGS,F.ALV ;DID WE PRINT IT ALREADY?
AOJA PIND,PRINT1 ;YES
MOVE B,CNT ;NO SO PRINT IT
PUSHJ PDP,PRTVAR
AOJA PIND,PRINT1
PRINT2: PUSHJ PDP,FUNCHK ;LOOK UP AS A FUNCTION
JRST PRINT3 ;NOT FOUND
TRNN FLAGS,F.ALF ;DID WE PRINT IT ALREADY?
PUSHJ PDP,PRISRC ;NO
AOJA PIND,PRINT1
PRINT3: PUSH PDP,FLAGS ;SAVE FLAGS
TRZ FLAGS,F.FCHR ;FORCE OUTPUT TO TTY
SPEAK NOTDEF ;NEITHER A FUNCTION OR A VARIABLE
POP PDP,FLAGS ;RESTORE FLAGS
AOJA PIND,PRINT1
PRT3A: JUMPE PIND,.+2
PUSHJ PDP,CRLF
TRZN FLAGS,F.FCHR ;LISTING?
JRST BEGIN ;NOPE
IFN FILCAP,<
CLOSE CHANO, ;CLOSE AND RELEASE DEVICE
RELEASE CHANO,
PUSHJ PDP,MBACK
JRST BEGIN
> ;END OF COND. ON FILCAP
PRINT4: PUSHJ PDP,CHKON ;CHECK FOR 'ON'
IFE FILCAP,<ERR NOFCAP>
IFN FILCAP,<
PUSHJ PDP,FILE
TLNN CHR,C.TERM
ERR NOTERM
PUSHJ PDP,CRLF ;PRINT A CARRIAGE-RETUN
PUSHJ PDP,DEVCHK
TLNN A,DV.IN ;CHECK FOR INPUT DEVICE
ERRF NOTID ;CANT
PUSHJ PDP,OPENI ;OPEN THE INPUT DEVICE AND LOOKUP FILE
JRST NOIFIL ;FILE NOT FOUND
MOVEI B,203*2 ;GET THIS MUCH BUFFER SPACE
PUSHJ PDP,MDOWN
PUSHJ PDP,GETWD ;GET 1ST WORD (FORMAT CODE)
ERRF EMPFIL ;FILE IS EMPTY
CAIE WD,FILCOD ;IS FORMAT CORRECT
JRST BADFIL ;NOPE
TRNN FLAGS,F.FCHR ;LISTING?
JRST PRT5A ;NOPE
SPEAK [ASCIZ /LISTING FROM /]
PUSHJ PDP,FILTYP
PUSHJ PDP,TABOUT
PUSHJ PDP,DATIM
PUSHJ PDP,CRLF
SPEAK [ASCIZ /FILE CREATED-- /]
LDB A,CREDAT ;GET DATE
PUSHJ PDP,DATE+1 ;AND PRINT IT
TRNE FLAGS,F.DTA ;DTA DOESN'T HAVE CREATION TIME
JRST PRT4B
PUSHJ PDP,TABOUT
LDB A,CRETIM ;GET TIME
IDIVI A,^D60 ;GET # HOURS INTO AC 'A'
MOVE N,A
PUSHJ PDP,DECPRO ;AND PRINT IT
PUSHJ PDP,COLON ;FOLLOWED BY A COLON
MOVE N,B ;GET # MINUTES
PUSHJ PDP,DECPRO
PRT4B: PUSHJ PDP,CRLF2
JRST PRT5A
PRINT5: PUSHJ PDP,SKIPDF ;SKIP THE DEFINTION
PRT5A: SETZ PIND, ;ZERO AN INDEX TO DUMARG
SETZM PARWD ;CLEAR PARITY WORD
PUSHJ PDP,GETWD ;GET A DEFINITION NAME
JRST PRINT8 ;FINISH UP
MOVE SYMBOL,WD ;NAME SANS BIT 35
TRZN SYMBOL,1 ;AND CHECK WHAT IT IS
JRST PRINT7 ;FUNCTION
SKIPN A,DUMARG(PIND) ;SCAN ARGUMENT TABLE
JRST PRINT6 ;NOT FOUND
CAME SYMBOL,A
AOJA PIND,.-3
SETOM DUMARG(PIND) ;NOTE WE'VE FOUND IT
JRST PRT6A
PRINT6: TRNN FLAGS,F.ALV ;PRINT ALL FUNCTIONS?
JRST PRINT5 ;NOPE SO SKIP THE DEF
PRT6A: PUSHJ PDP,GETWD ;GET THE VALUE
ERRF BADEOF
MOVE N,WD ;AND SAVE IT IN N
PUSHJ PDP,GETWD ;GET PARITY
ERRF BADEOF
SKIPE PARWD ;AND CHECK IT
ERRF PARERR
SPEAK [ASCIZ / %S=%F%_/]
TRO FLAGS,F.VARS ;NOTE A VARIABLE'S BEEN PRINTED
JRST PRT5A ;LOOP THOURH THE FILE
PRINT7: SKIPN A,DUMARG(PIND) ;SCAN ARGUMENT TABLE
JRST PRT7A ;NOT FOUND
CAME SYMBOL,A
AOJA PIND,.-3
SETOM DUMARG(PIND) ;NOTE IT'S BEEN FOUND
JRST PRT7B
PRT7A: TRNN FLAGS,F.ALF ;PRINT ALL FUNCTIONS?
JRST PRINT5 ;NO SO SKIP THE DEFINITION
PRT7B: PUSHJ PDP,TABOUT ;PRINT A TAB
PUSHJ PDP,SIXOUT ;AND THE NAME
PUSHJ PDP,GETWD ;GET THE HEADER
ERRF BADEOF
HRRZ FIND,WD ;GET # PNS WORDS
LDB CNT,[POINT 12,WD,17] ;AND # SOURCE WORDS
PRT7C: PUSHJ PDP,GETWD ;GET A WORD OF DEFINITION SOURCE
ERRF BADEOF
MOVE SYMBOL,WD
PUSHJ PDP,SIXOUT ;PRINT IT
SOJG CNT,PRT7C ;AND LOOP BACK FOR MORE
PUSHJ PDP,CRLF ;PRINT A RETURN
PUSHJ PDP,GETWD ;SKIP OVER THE PNS AND GET PARITY WORD
ERRF BADEOF
SOJGE FIND,.-2
SKIPE PARWD ;CHECK THE PARITY
ERRF PARERR
TRO FLAGS,F.FUNS ;NOTE A FUNCTION'S BEE PRINTED
JRST PRT5A
PRINT8: TRZN FLAGS,F.FCHR ;LISTING?
JRST RECAL4 ;FINISH AS A RECALL
CLOSE CHANO,
RELEASE CHANO,
JRST RECAL4
> ;END OF COND. ON FILCAP
;THE DELETE OR DEL COMMAND
;THE FORMATS ARE:
; DELETE ARG1,ARG2,...,ARGN
; DELETE ARG1,ARG2,...,ARGN ON DEV:FILNAM.EXT [PROJ,PROG]
;THE FIRST DELETES FROM IN CORE STORAGE WHILE THE SECOND DELETES
;FROM THE SPECIFIED FILE.
DELETE: PUSHJ PDP,GETARG ;PICK UP THE ARGUMENTS
ERR NOARGS ;NONE THERE
TLNN CHR,C.TERM ;DID THEY TERMINATE THE LINE RIGHT
JRST DELET4 ;CHECK FOR FILE SPECIFICATION
SETZ PIND,
TRNE FLAGS,F.ALV ;DELETE ALL VARIABLES?
PUSHJ PDP,DELALV ;YES
TRNE FLAGS,F.ALF ;DELETE ALL FUNCTIONS?
PUSHJ PDP,DELALF ;YES
DELET1: SKIPN SYMBOL,DUMARG(PIND) ;DONE WHEN ZERO WORD
JRST BEGINC
TRNE FLAGS,F.ALV ;HAVE WE DELETED ALL VARIABLES?
JRST DELET2 ;YES, NO NEED TO CHECK HERE
PUSHJ PDP,LABCHK ;LOOK IT UP AS A VARIABLE
JRST DELET2 ;NOT FOUND
CAILE CNT,2 ;DON'T ALLOW DELETION OF 'RESLT' OR 'SRSLT'
JRST .+3
SPEAK CNGRST
AOJA PIND,DELET1
MOVEI A,LABTAB(CNT) ;DO THE DELETION
HRLI A,LABTAB+2(CNT) ;BY MOVING FURTHER ENTRIES UP
SOS B,LABTOT ;A NOTCH AND SUBTRACTING ONE
IMULI B,2 ;FROM LABTOT
BLT A,LABTOT-1(B)
SPEAK DELMSG ;TELL THEM IT'S DONE
AOJA PIND,DELET1 ;AND CONTINUE
DELET2: TRNE FLAGS,F.ALF ;HAVE WE DELETED ALL FUNCTIONS?
JRST DELET3 ;YES
PUSHJ PDP,FUNCHK ;LOOK IT UP AS A FUNCTION
JRST DELET3 ;NOT DEFINED
SPEAK DELMSG
PUSHJ PDP,DELFN ;DO THE ACTUAL DELETION
AOJA PIND,DELET1 ;CONTINUE
DELET3: TRNE FLAGS,F.ALV ;HAVE WE DELETED ALL VARS
TRNN FLAGS,F.ALF ;AND ALL FUNS?
SPEAK NOTDEF ;NOPE
AOJA PIND,DELET1
DELET4: PUSHJ PDP,CHKON ;CHECK FOR 'ON'
IFE FILCAP,<ERR NOFCAP>
IFN FILCAP,<
PUSHJ PDP,FILE ;GET THE FILE INFO
TLNN CHR,C.TERM ;MUST TERMINATE THE LINE
ERR NOTERM
PUSHJ PDP,DEVCHK ;CHECK ON THE DEVICE
TLNN A,DV.DIR ;ONLY MAY DELETE FROM DIRECTORY DEVICE
ERR DRONLY
PUSHJ PDP,OPENI ;OPEN DEVICE AND LOOK UP FILE
JRST NOIFIL ;FILE NOT FOUND
PUSHJ PDP,OPENO ;OPEN OUTPUT DEVICE AND DO ENTER
;ALSO GET BUFFER SPACE
MOVEI B,203*4 ;GET THIS MUCH BUFFER SPACE
PUSHJ PDP,MDOWN
PUSHJ PDP,GETWD ;GET FIRST WORD (FORMAT CODE)
JRST DELET8
CAIE WD,FILCOD ;DOES IT MATCH?
JRST BADFIL ;NOPE
PUSHJ PDP,PUTWD ;PASS ON THE FILE CODE
DELET5: SETZM PARWD ;ZERO PARITY WORD
PUSHJ PDP,GETWD ;GET A DEFINITION NAME
JRST DELET7 ;EOF
MOVE SYMBOL,WD ;SANS BIT 35
TRZ SYMBOL,1
SETZ PIND, ;SCAN THROUGH ARGUMENT TABLE
SKIPN A,DUMARG(PIND)
JRST DELET6 ;NOT FOUND
CAME SYMBOL,A
AOJA PIND,.-3 ;LOOP THROUGH
SETOM DUMARG(PIND) ;FOUND SO NOTE THE FACT
JRST DELE6A
DELET6: MOVEI B,F.ALV ;ASSUME IT'S A VARIABLE
TRNN WD,1 ;FIND OUT FOR SURE
MOVEI B,F.ALF ;'TIS A FUNCTION, THOUGH
TDNN FLAGS,B ;DELETE ALL OF LIKE KIND?
JRST DELE6B ;NOPE PASS IT ON
DELE6A: PUSHJ PDP,SKIPDF ;SKIP (DELETE) IT
SPEAK DELMSG
JRST DELET5 ;LOOP THROUGH THE FILE
DELE6B: PUSHJ PDP,PASSDF ;PASS OVER THE DEFINITION
TRO FLAGS,F.VARS+F.FUNS ;NOTE WE'VE PASSED ON ONE
JRST DELET5 ;LOOP THROUGH THE FILE
DELET7: SETZ PIND, ;PRINT NAMES NOT FOUND
SKIPN SYMBOL,DUMARG(PIND)
JRST DELET8
CAMN SYMBOL,ONES
AOJA PIND,DELET7+1
SPEAK NOTDEF
AOJA PIND,DELET7+1
DELET8: PUSHJ PDP,CLOSF ;DO A REGULAR CLOSE
TRNE FLAGS,F.FUNS+F.VARS ;DID WE DELETE EVERYTING?
JRST BEGINC ;YES
MOVEI B,17 ;GET THE DEVICE FOR A DELETE
MOVEM B,OPENBK
SETZM OPENBK+2
OPEN CHANO,OPENBK
ERR OUTDER
MOVE B,FILBLT
BLT B,FILNAM+3
LOOKUP CHANO,FILNAM ;LOOKUP THE FILE AGAIN
JRST DELERR
SETZM FILNAM ;ZERO FILENAME FOR A DELETE
CLOSE CHANO,
RENAME CHANO,FILNAM ;DELETE THE FILE
ERRF RENERR ;CAN'T
RELEASE CHANO,
JRST BEGINC
> ;END COND. ON FILCAP
;THE STORE COMMAND -- STORES VARIABLES AND FUNCTIONS ON FILE
;THE FORMAT IS:
; STORE ARG1,ARG2,...,ARGN ON DEV:FILNAM.EXT<PROT>[PROJ,PROG]
;WHRE ARG1,ARG2,...,ARGN ARE FUNCTION AND VARIABLE NAMES OR THE
;SPECIAL ARGUMENTS 'ALLFUN' AND 'ALLVAR' WHICH STORE ALL FUNCTIONS AND
;ALL VARIABLES RESPECTIVELY. THE DEFAULT FILE SPECIFICATION IS:
; DSK:ABACUS.STO<155>[SELF]
IFN FILCAP,<
STOREF: PUSHJ PDP,GETARG ;GET THE ARGUMENTS
TRO FLAGS,F.ALF+F.ALV ;ASSUME ALL FUNCTIONS AND VARIABLES
TLNE CHR,C.TERM ;STATEMENT TERMINATION
JRST STORE1
PUSHJ PDP,CHKON ;CHECK FOR 'ON'
STORE1: PUSHJ PDP,FILE ;GET FILE SPECS
TLNN CHR,C.TERM ;MUST TERMINATE LINE
ERR NOTERM
SETZM PNS ;ZERO TOP OF PNS
MOVSI PIND,-PNSLEN
TRNN FLAGS,F.ALF ;STORE ALL FUNCTIONS?
JRST STOR1B ;NOPE
SETZ CNT,
MOVEI A,@FNSTPT ;GET 1ST FUNCTION ADR.
CAMGE A,FUNNXT ;ANY DEFINED?
JRST STOR1A ;YES
TRZ FLAGS,F.ALF ;NOPE--NOTE IT
SPEAK NOFUNS ;AND TELL THEM SO
JRST STOR1B
STOR1A: MOVEI A,@FNSTPT ;GET FUNCTION ADR.
CAML A,FUNNXT ;GOT THEM ALL?
JRST STOR1B ;YES
MOVE SYMBOL,@FNSTPT ;GET FUNCTION NAME
PUSHJ PDP,DUMONE ;SET A MATCHING DUMARG ENTRY TO -1
MOVEM SYMBOL,PNS(PIND) ;SAVE NAME IN PNS
AOJ CNT, ;ADVANCE TO FUNCTION HEADER
HRRZ B,@FNSTPT ;GET # PNS WORDS
LDB A,FNBPT1 ;AND # SORCE WORDS
ADD CNT,B
ADDI CNT,1(A) ;ADVANCE CNT TO NEXT FUNCTION
AOBJN PIND,STOR1A ;LOOP THROUGH FUNCTIONS
ERR PNSFUL
STOR1B: TRNN FLAGS,F.ALV ;STORE ALL VARIABLES?
JRST STOR1D ;NOPE
MOVE CNT,LABTOT ;GET NUMBER TO STORE
CAILE CNT,2 ;BUT DON'T STORE 'RESLT' OR 'SRSLT'
JRST .+4
TRZ FLAGS,F.ALV ;NOTE THERE ARE NONE
SPEAK NOVARS
JRST STOR1D
MOVNS CNT
HRLZS CNT
ADD CNT,ONETWO ;SKIP OVER PREDEFINED(2)
ADD CNT,ONETWO
STOR1C: JUMPGE CNT,STOR1D ;FINISHED BUILDING TABLE?
MOVE SYMBOL,LABTAB(CNT) ;GET A VARIABLE NAME
PUSHJ PDP,DUMONE
MOVEM SYMBOL,PNS(PIND) ;STORE IN PNS
ADD CNT,ONETWO ;ADVANCE TO NEXT VARIABLE
AOBJN PIND,STOR1C ;LOOP THROUGH VARIABLES
ERR PNSFUL
STOR1D: SETZ CNT,
STOR1E: SKIPN SYMBOL,DUMARG(CNT) ;GET A DUMMY ARG
JRST STOR1F ;DONE WHEN ZERO WORD
CAMN SYMBOL,ONES ;-1 IF DUPLICATE NAME
AOJA CNT,STOR1E
MOVEM SYMBOL,PNS(PIND) ;SAVE IT IN PNS
AOJ CNT,
AOBJN PIND,STOR1E ;LOOP THROUGH DUMARG
ERR PNSFUL
STOR1F: SETZM PNS(PIND) ;PUT AND END TO PNS
PUSHJ PDP,DEVCHK ;GET DEVICE CHARACTER
TLNN A,DV.DIR ;DIRECTORY DEVICE?
JRST STORE9 ;NOPE SO CAN ONLY DO OUTPUT
PUSHJ PDP,OPENI ;OPEN INPUT DEVICE AND LOOKUP FILE
JRST STORE9 ;FILE NOT FOUND
PUSHJ PDP,OPENO ;OPEN DEVICE AND ENTER FILE
MOVEI B,203*4 ;GET THIS MUCH BUFFER SPACE
PUSHJ PDP,MDOWN
PUSHJ PDP,GETWD ;GET 1ST WORD (FORMAT CODE)
JRST STOR9A ;IMMEDIATE EOF
CAIE WD,FILCOD ;IS THE FORMAT RIGHT?
JRST BADFIL ;TOO BAD!!
PUSHJ PDP,PUTWD ;PASS ON THE FORMAT CODE
STORE2: SETZM PARWD ;CLEAR PARITY WORD
PUSHJ PDP,GETWD ;GET THE SYMBOL NAME
JRST STORE7 ;EOF OF INPUT FILE--NOW TRANSFER
MOVE SYMBOL,WD ;GET NAME SANS BIT 35
TRZ SYMBOL,1
SETZ PIND, ;ZERO PIND
STOR2A: SKIPN A,PNS(PIND) ;GET AN ITEM OF PNS
JRST STOR2E ;AT END OF PNS
CAMN SYMBOL,A ;SAME AS ON FILE?
JRST STOR2B ;MATCH
AOJA PIND,STOR2A ;NOPE--KEEP CHECKING
STOR2B: SETOM PNS(PIND) ;NOTE THE MATCH
SPEAK DEFONE ;TELL THEM SO
SPEAK OVERLY ;ASK WHAT TO DO
PUSHJ PDP,YESNO ;GET THEIR ANSWER
JRST STOR2E ;DON'T WISH TO OVERLAY
PUSHJ PDP,FUNCHK ;LOOKUP AS FUNCTION
JRST .+3 ;NOT FOUND
PUSHJ PDP,STOFUN ;STORE IT
JRST STOR2C
PUSHJ PDP,LABCHK ;LOOKUP AS A VARIABLE
JRST STOR2D ;NOT DEFINED
PUSHJ PDP,STOVAR ;STORE IT
STOR2C: PUSHJ PDP,SKIPDF ;DELETE OLD DEFINITION
JRST STORE2 ;LOOP THROUGH FILE
STOR2D: SPEAK NOTDEF ;NOT DEFINED
STOR2E: PUSHJ PDP,PASSDF ;PASS OVER DEFINITON
JRST STORE2 ;LOOP THOUGH THE FILE
STORE7: SETZ PIND, ;ZERO PIND
STOR7A: SKIPN SYMBOL,PNS(PIND) ;GET NAME FROM PNS
JRST STORE8 ;FINISHED AT LAST WITH TRANSFER
CAMN SYMBOL,ONES ;THIS ONE DONE ALREADY?
AOJA PIND,STOR7A ;YES
PUSHJ PDP,FUNCHK ;LOOK UP AS A FUNCTION
JRST .+3
PUSHJ PDP,STOFUN ;STORE IT
AOJA PIND,STOR7A ;LOOP THROUGH PNS
PUSHJ PDP,LABCHK ;LOOK UP AS A VARIABLE
JRST STOR7B ;NOT FOUND
PUSHJ PDP,STOVAR ;STORE IT
AOJA PIND,STOR7A ;LOOP THOUGH PNS
STOR7B: SPEAK NOTDEF
AOJA PIND,STOR7A
STORE8: PUSHJ PDP,CLOSF ;CLOSE FILES
JRST BEGINC ;RETURN TO COMMAND LEVEL
STORE9: TLNN A,DV.OUT ;CAN THE DEVICE DO OUTPUT?
ERRF NOTOD ;NOPE
PUSHJ PDP,OPENO ;OPEN THE DEVICE AND ENTER THE FILE
MOVEI B,203*2 ;GET THIS MUCH BUFFER SPACE
PUSHJ PDP,MDOWN
STOR9A: MOVEI WD,FILCOD ;GET THE FILE FORMAT WORD
PUSHJ PDP,PUTWD ;AND OUTPUT IT
JRST STORE7 ;NOW TRANSFER THE DEFINTIONS TO FILE
> ;END OF COND. ON FILCAP
;THE RECALL COMMAND -- RECALLS VARIABLES AND FUNCTIONS FROM FILE
;THE FORMAT IS:
; RECALL ARG1,ARG2,...,ARGN ON DEV:FILNAM.EXT[PROJ,PROG]
;WHRE ARG1,ARG2,...,ARGN REPRESENT THE NAMES OF THE VARIABLES OR
;FUNCTIONS TO BE RECALLED. THE SPECIAL ARGUMENTS 'ALLVAR' AND 'ALLFUN'
;MAY BE USED TO RECALL ALL VARIABLES AND FUNCTIONS RESPECTIVELY.
IFN FILCAP,<
RECALL: PUSHJ PDP,GETARG ;GET THE ARGUMENTS
TRO FLAGS,F.ALF+F.ALV ;ASSUME ALL FUNCTIONS AND VARIABLES
TLNE CHR,C.TERM ;STATEMENT TERMINATED?
JRST RECAL1 ;YES--SET DEFAULT FILE
PUSHJ PDP,CHKON ;CHECK FOR 'ON'
RECAL1: PUSHJ PDP,FILE ;GET THE FILE INFO
TLNN CHR,C.TERM ;MUST TERMINATE
ERR NOTERM
PUSHJ PDP,DEVCHK ;CHECK DEVICE CHARACTER
TLNN A,DV.IN ;CAN IT DO INPUT
ERR NOTID ;NOPE--YOU GOOFED
PUSHJ PDP,OPENI ;OPEN DEVICE AND LOOKUP FILE
JRST NOIFIL ;NOT FOUND
MOVEI B,203*2 ;GET THIS MUCH BUFFER SPACE
PUSHJ PDP,MDOWN
PUSHJ PDP,GETWD ;GET 1ST WORD OF FILE (FORMAT CODE)
ERRF EMPFIL
CAIE WD,FILCOD ;CHECK THE FORMAT
JRST BADFIL ;WRONG!!
PUSHJ PDP,CRLF ;FANCY UP TO TTY
JRST .+2 ;SKIP OVER THIS ON ENTRY
RECL1A: PUSHJ PDP,SKIPDF ;SKIP THE DEFINITION
RECL1B: SETZ PIND, ;ZERO AN INDEX TO DUMARG
SETZM PARWD ;ZERO PARITY WORD
PUSHJ PDP,GETWD ;GET A DEFINITION NAME
JRST RECAL4 ;EOF
MOVE SYMBOL,WD ;GET NAME SANS BIT 35
TRZN SYMBOL,1 ;AND CHECK TYPE
JRST RECAL3 ;FUNCTION
SKIPN A,DUMARG(PIND) ;VARIABLE--SCAN DUMARG TABLE
JRST RECAL2 ;NOT FOUND
CAME SYMBOL,A
AOJA PIND,.-3
SETOM DUMARG(PIND) ;NOTE WE'VE FOUND THIS ONE
JRST RECL2A
RECAL2: TRNN FLAGS,F.ALV ;WANT ALL VARIABLES?
JRST RECL1A ;NOPE SO WE SKIP THIS DEF
RECL2A: PUSHJ PDP,GETWD ;GET VALUE
ERRF BADEOF
MOVE N,WD ;AND SAVE IT
PUSHJ PDP,GETWD ;GET PARITY
ERRF BADEOF
SKIPE PARWD ;AND CHECK IT
ERRF PARERR
PUSHJ PDP,LABCHK ;SEE IF THE VARIABLE EXISTS
JRST RECL2C ;NOT THERE
RECL2B: MOVEM N,LABTAB+1(CNT) ;STORE THE VALUE
SPEAK RECMSG ;TELL THEM ALL'S WELL
TRO FLAGS,F.VARS ;NOTE WE'VE GOT A VARIABLE
JRST RECL1B ;LOOP THROUGH THE FILE
RECL2C: PUSHJ PDP,RESCHK ;IS IT A RESERVED WORD?
JRST RECL1B ;YES--DON'T LET THEM SAVE IT
HLLI CNT, ;CLEAR LEFT OF CNT
CAILE CNT,LTLEN ;ROOM FOR ONE MORE VARIABLE?
ERRF LABFUL ;NOPE
MOVEM SYMBOL,LABTAB(CNT) ;CREATE NEW LABLE IN TABLE
AOS LABTOT ;AND SHOW ONE MORE
JRST RECL2B
RECAL3: SKIPN A,DUMARG(PIND) ;FUNCTION--SCAN THROUGH DUMARG
JRST RECL3A ;NOT FOUND
CAME SYMBOL,A
AOJA PIND,.-3
SETOM DUMARG(PIND) ;NOTE WE'VE FOUND IT
JRST RECL3B
RECL3A: TRNN FLAGS,F.ALF ;RECALL ALL FUNCTIONS?
JRST RECL1A ;NOPE--SKIP THIS DEF
RECL3B: PUSHJ PDP,RESCHK ;CHECK FOR RESERVED WORDS
JRST RECL3E ;OH-OH!
MOVEM SYMBOL,@FUNNXT ;SAVE THE NAME
MOVEI FIND,1 ;TO POINT TO PLACE FOR HEADER
MOVE A,FUNNXT
HRRM A,FUNPNT ;SET UP FUNCTION POINTER WORD
PUSHJ PDP,GETWD ;GET HEADER WORD
ERRF BADEOF
HRRZ B,WD ;GET # PNS WORDS
LDB C,[POINT 12,WD,17] ;AND # SOURCE WORDS
ADDI B,1(C) ;ADD TO GET # WORDS TO READ
ADDI A,1(B) ;ADD AGAIN TO GET MAX CORE LOCATION
CAMGE A,FUNMAX ;NEED TO EXPAND CORE?
JRST RECL3C ;NOPE
CALLI A,11 ;THE CORE UUO
ERRF NOCORE ;CAN'T EXPAND
HRRZ A,.JBREL
MOVEM A,FUNMAX ;NEW MAXIMUM
RECL3C: MOVNS B ;SET UP AOBJN WORD
HRL FIND,B ;IN AC 'FIND'
RECL3D: MOVEM WD,@FUNPNT ;STORE A WORD OF DEF
PUSHJ PDP,GETWD ;GET A WORD FROM FILE
ERRF BADEOF
AOBJN FIND,RECL3D ;LOOP THROUG THE DEF
SKIPE PARWD ;CHECK PARITY WORD
ERRF PARERR ;BAD!
MOVEI A,@FUNPNT ;GET NEW FUNNXT LOCATION
MOVEM A,FUNNXT ;AND UPDATE
SPEAK RECMSG ;TELL THEM IT'S OK
TRO FLAGS,F.FUNS ;NOTE WE'VE GRABED A FUNCTION
JRST RECL1B ;LOOP THROUGH THE FILE
RECL3E: PUSHJ PDP,THRUST ;SKIP TO END OF STATEMENT
SPEAK RENMSG ;ASK WHAT TO DO
PUSHJ PDP,SSPACE ;GET A CHARACTER
TLNE CHR,C.CR ;CR IF DON'T WANT TO RECALL
JRST RECL1A ;SKIP THE DEFINITION
TLNN CHR,C.LETT ;LETTER MUST START NEW NAME
JRST RECL3F
MOVEI CNT,5
PUSHJ PDP,LABIN
JRST RECL3F
PUSHJ PDP,THRUST ;SKIP TO END OF STATEMENT
JRST RECL3B
RECL3F: SPEAK BADFNM ;BAD FUNCTION NAME
JRST RECL3E ;TRY AGAIN
RECAL4: CLOSE CHANI, ;CLOSE THE INPUT FILE
RELEASE CHANI, ;AND RELEASE DEVICE
PUSHJ PDP,MBACK ;RECLAME BUFFER SPACE
TRNN FLAGS,F.ALF ;DID THEY WANT ALL FUNCTIONS?
JRST RECL4A ;NOPE
TRNN FLAGS,F.FUNS ;YES--BUT DID WE SEE ANY?
SPEAK NOFUNS ;TELL THEM WE DIDN'T
RECL4A: TRNN FLAGS,F.ALV ;DID THEY WANT ALL VARIABLES?
JRST RECL4B ;NOPE
TRNN FLAGS,F.VARS ;YES--BUT DID WE SEE ANY?
SPEAK NOVARS ;NOPE
RECL4B: SETZ PIND, ;ZERO INDEX TO DUMARG
SKIPN SYMBOL,DUMARG(PIND) ;SCAN TABLE FOR THOSE NOT FOUND
JRST BEGINC ;DONE!!!!!!
CAME SYMBOL,ONES ;ALL ONES MEANS FOUND
SPEAK NOTDEF
AOJA PIND,RECL4B+1 ;LOOP THROUGH
> ;END OF COND. ON FILCAP
;THE HELP COMMAND
;THE FILE DSK:ABACUS.HLP [LIBPPN] IS PRINTED ON THE TTY OR LPT (IF /L)
IFN FILCAP,<
HELP: MOVSI B,(SIXBIT /TTY/) ;ASSUME TTY
TLNE CHR,C.TERM ;DID THEY TERMINATE AFTER 'HELP'?
JRST HELP1 ;YES
MOVEI C,'/' ;SLASH FOR SWITCH?
CAIE C,(CHR)
ERR BADHLP ;NOPE
PUSHJ PDP,SSPACE ;GET NEXT CHARACTER
MOVEI CNT,1 ;ALLOW ONLY ONE
PUSHJ PDP,LABIN ;GET LABLE
ERR BADHLP
CAME SYMBOL,[SIXBIT /L/]
ERR BADHLP ;NOPE
TLNN CHR,C.TERM ;MUST TERMINATE
ERR NOTERM ;SHAME
MOVSI B,(SIXBIT /LPT/) ;SET FOR LPT
HELP1: MOVEM B,OPENBK+1 ;SAVE DEVICE NAME
CALLI B,4 ;DEVCHR CALLI
TLNN B,DV.LPT+DV.TTY ;MUST BE TTY OR LPT (IF ASS)
ERR BADHP1
MOVEI B,ASCMOD ;MODE IS ASCII
MOVEM B,OPENBK
MOVEI B,OBUF
HRLZM B,OPENBK+2 ;SET UP OUTPUT BUFFER
OPEN CHANO,OPENBK ;OPEN THE DEVICE
ERR OUTDER
MOVE B,CUSP ;SET UP FILE NAME
MOVEM B,FILDAT
MOVSI B,(SIXBIT /HLP/)
MOVEM B,FILDAT+1
SETZM FILDAT+2
SETZM FILDAT+3
MOVSI B,(SIXBIT /SYS/) ;SET UP OPEN BLOCK
MOVEM B,OPENBK+1
MOVEI B,ASCMOD ;INPUT MODE IS ASCII
PUSHJ PDP,OPENI+1 ;OPEN INPUT DEVICE AND LOOKUP FILE
JRST NOIFIL ;NOT FOUND
MOVE B,[EXP 203*2+37*2] ;GET THIS MUCH BUFFER SPACE
PUSHJ PDP,MDOWN
HELP2: PUSHJ PDP,GETWD ;GET A CHARACTER
ERRF ;DONE SO CLOSE FILES
PUSHJ PDP,PUTWD ;PUT OUT A CHARACTER
JRST HELP2 ;LOOP
> ;END OF COND. ON FILCAP
;THE STATUS OR STAT COMMAND -- PRINTS A USAGE SUMMARY
STATS: TLNN CHR,C.TERM ;MUST TERMINATE LINE
ERR SINGLE
SPEAK STMSG
PUSHJ PDP,TIME ;PRINT TIME OF DAY
PUSHJ PDP,CRLF2
SPEAK RUNMSG
PUSHJ PDP,RNTIME ;THE RUNTIME
PUSHJ PDP,TABOUT
SPEAK CNTMSG
PUSHJ PDP,CNTIME ;THE CONNECT TIME
PUSHJ PDP,CRLF2
MOVE N,RESLT ;THE VALUES OF 'RESLT' AND 'TOT'
SPEAK RSTMSG
MOVE N,TOT
SPEAK SRTMSG
PUSHJ PDP,PRTALV ;ALL VARIABLE ASSIGNMENTS
PUSHJ PDP,PRTALF ;ALL FUNCTION DEFINITIONS
IFN DEBUG,<
PUSHJ PDP,CORUSR ;AND CORE USAGE (IF DEBUG MODE)
>
JRST BEGINC
;THE CORUSE COMMAND -- PRINTS CORE USAGE (IF DEBUG MODE)
IFN DEBUG,<
CORUSE: PUSHJ PDP,CORUSR
JRST BEGINC
CORUSR: PUSHJ PDP,CRLF
HRRZ N,FNSTPT
SPEAK CORUS1 ;INITIAL FUNC. LOC.
MOVE N,FUNNXT
SPEAK CORUS2 ;NEXT FUNCT. LOC.
MOVE N,FUNMAX
SPEAK CORUS3 ;MAX FUNCT. LOC.
HRRZ B,.JBREL
IDIVI B,^D1024 ;CALCULATE NUMBER OF BLOCKS OF CORE
SKIPE C
ADDI B,1
MOVE N,B
SPEAK CORUS4 ;BLOCKS CORE
POPJ PDP,
;THE PNS COMMAND -- PRINTS PNS IN READABLE FORM (IF DEBUG MODE)
PNSCHK: SETZ PIND,
PUSHJ PDP,CRLF
MOVE N,PNS(PIND) ;GET ITEM OF PNS
LDB A,[POINT 6,N,5] ;GET THE OPCODE
TLZ N,770000 ;CLEAR THE OPCODE
MOVE SYMBOL,OPCLAB(A) ;GET THE OPCODE MNEMONIC
PUSHJ PDP,SIXOUT
PUSHJ PDP,SPACEO
CAIN A,6 ;AN OPDC?
JRST PNSCH1
CAIN A,13 ;AN FJUMP?
JRST PNSCH2
CAIE A,10 ;A PCALL?
CAIN A,14 ;A STORE?
JRST PNSCH4
CAIN A,7 ;A CONCAL?
JRST PNSCH3
CAIE A,11 ;ARE WE DONE?
CAIN A,15
JRST BEGINC ;YES
AOJA PIND,PNSCHK+1 ;NO, KEEP AT IT
PNSCH1: MOVE SYMBOL,N
LSH SYMBOL,6
PUSHJ PDP,SIXOUT
PUSHJ PDP,SPACEO
PUSHJ PDP,LABCHK
AOJA PIND,PNSCHK+1
MOVE N,LABTAB+1(CNT)
PUSHJ PDP,FLOCON
AOJA PIND,PNSCHK+1
PNSCH2: MOVE SYMBOL,N
PUSHJ PDP,SIXOUT
AOJA PIND,PNSCHK+1
PNSCH3: AOJ PIND,
MOVE N,PNS(PIND)
PUSHJ PDP,FLOCON
AOJA PIND,PNSCHK+1
PNSCH4: PUSHJ PDP,DECPNT
AOJA PIND,PNSCHK+1
OPCLAB: SIXBIT /PLUS/ ;TABLE OF SIXBIT OPCODES
SIXBIT /MINUS/
SIXBIT /MULT/
SIXBIT /DIVIDE/
SIXBIT /EXPON/
SIXBIT /NEGAT/
SIXBIT /OPDC/
SIXBIT /CONCAL/
SIXBIT /PCALL/
SIXBIT /FRET/
SIXBIT /REDYF/
SIXBIT /FJUMP/
SIXBIT /STORE/
SIXBIT /DONE/
SIXBIT /DOCALL/
;THE DDT COMMAND -- TRANSFERS CONTROL TO DDT (IF DEBUG MODE)
DDTST: SKIPN .JBDDT ;IS DDT LOADED?
ERR [ASCIZ /DDT NOT LOADED/]
TTCALL 11,
HRRZ BPT,.JBDDT
JRST (BPT)
> ;END COND. ON DEBUG
SUBTTL VARIOUS SUBROUTINES
;ROUTINE TO GET A VALUE EITHER AS A NUMBER FROM THE TTY OR AS A VALUE
;TO A LABLE FROM THE TTY
;CALL PUSHJ PDP,GETVAL
;GETVAL INPUTS THE FIRST CHARACTER ITSELF!!
GETVAL: PUSHJ PDP,SSPACE ;GET NEXT CHR
TLNN CHR,C.OPR ;CHECK OPERATOR
JRST .+6
MOVEI A,(CHR) ;GET RIGHT HALF
CAIE A,'-' ;NEG SIGN?
JRST .+3
TRO FLAGS,F.MINV ;NOTE THAT IT'S NEG.
PUSHJ PDP,SSPACE ;NO GET ANOTHER
TLNN CHR,C.DIGI+C.DOT ;NUMBER?
JRST GETVL1
PUSHJ PDP,FLICON ;GET THE NUMBER
TRZE FLAGS,F.MINV ;IS IT NEG?
MOVNS N ;YES SO DO YOUR THING
POPJ PDP,
GETVL1: TLNN CHR,C.LETT ;LETTER?
ERR BADLVR
MOVEI CNT,5 ;5 CHRS MAX
PUSHJ PDP,LABIN ;GET THE LABLE
JRST LABLON
PUSHJ PDP,LABCHK ;LOOK IT UP
ERR UNDVAR ;UNDEFINED
MOVE N,LABTAB+1(CNT) ;GET ITS VALUE INTO AC "N"
POPJ PDP,
;ROUTINE TO CONVERT TO POLISH STRING NOTATION
;ENTRY POINTS: 1) PUSHJ PDP,POLCON -- FULL SCAN
; 2) PUSHJ PDP,POLCON+1 -- "CHR" READY TO GO
; 3) PUSHJ PDP,POLC1 -- NOT AN ALPHA
; 4) PUSHJ PDP,POLC2 -- A NUMBER
; 5) PUSHJ PDP,POLC3 -- "SOMETHING ELSE"
; 6) PUSHJ PDP,POLC4 -- A LABLE ALREADY GOTTEN
;UNLESS ERROR, RETURNS ALWAYS WITH A POPJ PDP,
POLCON: PUSHJ PDP,SSPACE ;GET A CHARACTER SKIPING SPACES
TLNE CHR,C.LETT ;A LETTER?
JRST VARBLE
POLC1: TLNE CHR,C.DIGI+C.DOT ;NUMERIC?
JRST POLC2 ;YES
POLC3: TLNE CHR,C.LPAR ;A LEFT PARENTHESIS?
JRST LPAREN
TLNE CHR,C.RPAR ;A RIGHT PARENTHESIS?
JRST RPAREN
TLNE CHR,C.OPR ;OPERATOR?
JRST OPERAT ;YES IT SURE IS
TLNE CHR,C.COMA ;COMMA BETWEEN ARGS?
JRST COMMA ;YOU BET!
TLNE CHR,C.EQAL ;EQUAL SIGN?
ERR BADEQL ;BAD EQUAL SIGN HERE
TLNN CHR,C.TERM ;END OF THIS STATEMENT?
ERR BADCHR ;BAD CHARACTER
TRNE FLAGS,F.LOPP ;LAST OPERATOR FLAG?
ERR TRAOPP ;YES TRAILING OPERATOR
DONE1: CAMN STACK,STKST ;DL EMPTY?
JRST DONE2 ;YES
POP STACK,SYMBOL ;POP IT OFF DL
MOVEM SYMBOL,PNS(PIND) ;STORE IN PNS
LDB SYMBOL,OPCPNT ;GET THE OPCODE
CAIN SYMBOL,13 ;AN FJUMP?
ERR BADFCL ;BAD END TO CALL
CAIN SYMBOL,15 ;A LEFT PARENTHESIS?
ERR NORPAR
AOBJN PIND,DONE1 ;CONTINUE TO TRANSFER DL
ERR PNSFUL
DONE2: TRNE FLAGS,F.LPAR ;THIS MUST NOT BE ON
ERR IMPEXP ;IMPROPER EXPRESSION
MOVE SYMBOL,.DONE ;GET THE DONE OPCODE
TRNE FLAGS,F.DEFN ;IS THIS A DEFINITION?
MOVE SYMBOL,.FRET ;GET THE FRET OPCODE
MOVEM SYMBOL,PNS(PIND) ;STORE IN PNS
POPJ PDP, ;WE DONE DID IT!!
VARBLE: TRZ FLAGS,F.LPAR+F.LOPP
TRZE FLAGS,F.LVAR ;TWO VARIABLES OR NUMBERS ADJACENT?
ERR ADJVAR ;YES
MOVEI CNT,5 ;ALLOW 5 CHARACTERS MAX
PUSHJ PDP,LABIN ;GET THE LABLE
JRST LABLON ;TOO MANY
POLC4: TLNE CHR,C.EQAL ;EQUAL SIGN?
JRST VARBL4 ;GREAT!
TLNE CHR,C.LPAR ;LEFT PARENTHESIS TO START ARGS?
JRST VARBL8 ;GOODY!
TRNN FLAGS,F.DEFN ;DEFINING?
JRST VARBL1 ;NO
MOVN CNT,NARGS ;NUMBER OF DUMMY ARGUMENTS
HRLZS CNT
CAMN SYMBOL,DUMARG(CNT) ;IS IT THIS DUMMY ARG?
JRST VARBL3 ;MATCH
AOBJN CNT,.-2 ;NOT THIS ONE-SO KEEP LOOKING
VARBL1: LSH SYMBOL,-6 ;NOT A DUMMY ARG AT ALL
IOR SYMBOL,.OPDC ;MAKE AN OPCODE OPDC
VARBL2: MOVEM SYMBOL,PNS(PIND) ;STORE IN PNS
TRO FLAGS,F.LVAR ;FLAG AS A LAST VARIABLE
AOBJN PIND,POLCON+1 ;ADVANCE PNS INDEX AND CONTINUE
ERR PNSFUL
VARBL3: HLLI CNT, ;CLEAR THE LEFT HALF
SUB CNT,NARGS ;SET UP THE PCALL WORD
MOVN SYMBOL,CNT
IOR SYMBOL,.PCALL
JRST VARBL2
VARBL4: TRO FLAGS,F.LPAR ;SET TO ALLOW NEGATION
CAMN STACK,STKST ;EMPTY STACK?
JRST VARBL5 ;YES
LDB A,[POINT 6,(STACK),5] ;GET LAST OPCODE
VARBL5: PUSHJ PDP,LABCHK ;LOOK UP THE VARIABLE
JRST VARBL7 ;NOT FOUND
CAIG CNT,2 ;DON'T CHANGE 'RESLT' OR 'TOT'
ERR CNGRST
VARBL6: MOVE SYMBOL,.STORE ;SET UP STORE OPCODE
HRR SYMBOL,CNT
PUSH STACK,SYMBOL
JRST POLCON ;AND CONTINUE
VARBL7: PUSHJ PDP,RESCHK ;IS IT A RESERVED WORD?
ERR ;YES
HLLI CNT, ;CLEAR LEFT
CAILE CNT,LTLEN ;ROOM FOR ONE MORE VARIABLE?
ERR LABFUL ;NOPE
MOVEM SYMBOL,LABTAB(CNT) ;SAVE THE NAME
SETZM LABTAB+1(CNT) ;GIVE IT A ZERO VALUE
AOS LABTOT ;SHOW WE'VE ONE MORE LABLE
JRST VARBL6 ;AND BACK WE GO
VARBL8: LSH SYMBOL,-6 ;IS A FUNCTION CALL THEN
IOR SYMBOL,.FJUMP ;SET UP OPCODE FJUMP
PUSH STACK,SYMBOL ;AND PUSH ONTO DELIMITER LIST
MOVE SYMBOL,.REDYF ;SET UP OPCODE REDYF
MOVEM SYMBOL,PNS(PIND) ;STORE IN PNS
TRO FLAGS,F.LPAR ;TURN ON LEFT PAREN FLAG
AOBJN PIND,POLCON
ERR PNSFUL
POLC2: TRZ FLAGS,F.LOPP+F.LPAR
TROE FLAGS,F.LVAR
ERR ADJVAR
PUSHJ PDP,FLICON ;GET IN THE NUMBER
MOVE SYMBOL,.CONCL ;SET UP OPCODE CONCAL
MOVEM SYMBOL,PNS(PIND) ;STORE IN PNS
AOBJN PIND,.+2
ERR PNSFUL
MOVEM N,PNS(PIND) ;PLACE VALUE IN PNS
AOBJN PIND,POLCON+1
ERR PNSFUL
LPAREN: TRZ FLAGS,F.LOPP
TRZE FLAGS,F.LVAR ;CAN ONLY HAPPEN IF NBER WAS
ERR MISOPP
TRO FLAGS,F.LPAR
PUSH STACK,.LPARN ;PUSH LEFT PAREN CODE ONTO DL
JRST POLCON
RPAREN: TRZE FLAGS,F.LPAR+F.LOPP
ERR MISRP ;MISPLACED RIGHT PAREN
CAMN STACK,STKST ;DL EMPTY?
ERR EXRP ;EXTRA RIGHT PAREN
POP STACK,SYMBOL
LDB A,OPCPNT ;GET OPCODE
CAIN A,13 ;IS IT THE FJUMP?
JRST LPARN1
CAIN A,15 ;IS IT A LEFT PARENTHESIS?
JRST POLCON ;YES--SIMPLY TOSS AWAY
MOVEM SYMBOL,PNS(PIND) ;TRANSFER TO PNS
AOBJN PIND,RPAREN+2
ERR PNSFUL
LPARN1: MOVEM SYMBOL,PNS(PIND) ;MOVE THE FJUMP TO PNS
AOBJN PIND,POLCON
JRST PNSFUL
OPERAT: TRZ FLAGS,F.LVAR
TROE FLAGS,F.LOPP ;SET AND CHECK F.LOPP
JRST OPERA2 ;CHECK FURTHER TO ALLOW NEGATION
TRZE FLAGS,F.LPAR ;IS LEFT PAREN ON?
JRST OPERA2 ;CHECK FURTHER FOR NEGATION
PUSHJ PDP,OPPCHK ;LOOK UP THE OPERATOR
OPERA1: JUMPG B,OPERA3 ;PRIORITY=1 THEN DONE?
POP STACK,SYMBOL ;NO SO POP OFF DL
MOVEM SYMBOL,PNS(PIND) ;AND SAVE IN PNS
PUSHJ PDP,DELPRI ;GET THE NEW PRIORITY
AOBJN PIND,OPERA1
ERR PNSFUL
OPERA2: HLLI CHR, ;IS IT NEGATION?
CAIE CHR,'-'
ERR LEDADJ ;ONLY NEG. AT START OF EXPRESSION
MOVE A,.NEGAT ;SET UP OPCODE NEGAT
OPERA3: PUSH STACK,A ;PUSH ONTO DL
JRST POLCON
;ROUTINE TO HANDLE OPERATOR AND PRIORITY LOOKUPS
;FOR NEW OPERATOR--CALL PUSHJ PDP,OPPCHK
;RETURN OPCODE IN BITS 0-5 OF "A" AND PRIORITY IN "B"
;ON SUBSEQUENT SEARCHES--CALL PUSHJ PDP,DELPRI
;NOTE: 1) DO NOT DESTROY AC "CNT" BETWEEN CALLS ON SAME NEW OPERATOR
; 2) 0 PRIORITY MEANS TO POP THE LAST DL
; 1 PRIORITY MEANS TO PUSH NEW DL
; 3) IF OPERATOR IS NOT FOUND--JRSTS TO BADEQ
OPPCHK: HLLI CHR, ;CLEAR LEFT HALF OF "CHR"
HRLZI CNT,OTLEN ;SET UP A CONTROL COUNT
HLRZ A,OPPTAB(CNT) ;GET LH OF TABLE ENTRY
CAMN CHR,A ;COMPARE THE TWO
JRST OPPCH1 ;FOUND!
AOBJN CNT,OPPCHK+2 ;NOT THIS ONE
ERR INTEQ ;BAD PLACE FOR EQUAL SIGN
OPPCH1: HRLZ A,CNT ;SET UP OPCODE BY SHIFTING COUNT
LSH A,^D12 ;INTO BITS 0-5 OF "A"
DELPRI: MOVEI B,1
CAMN STACK,STKST ;IS DL EMPTY?
POPJ PDP, ;YES SO PRIORITY=1
MOVE SYMBOL,(STACK) ;GET LAST DELIMITER
LDB SYMBOL,OPCPNT ;GET ITS OPCODE
CAIL SYMBOL,13 ;IS IT FJUMP,STORE, OR "("
POPJ PDP, ;YES SO PRIORITY=1
HRLZ B,OPPTAB(CNT) ;GET PRIORITY OR FLAG
JUMPGE B,CPOPJ ;IT IS PRIORITY SO RETURN
SETZ B, ;FLAGGED SO LOOK FURTHER
CAIG SYMBOL,1 ;OPCODE>1 SO, 0 PRIORITY
MOVEI B,1 ;SET PRIORITY=1 IF OPCODE<=1
CPOPJ: POPJ PDP,
OPPTAB: XWD '+',0 ;TABLE OF OPERATORS AND THEIR PRIORITY
XWD '-',0
XWD '*',-1
XWD '/',-1
XWD '^',1
OTLEN=OPPTAB-. ;LENGTH OF TABLE
COMMA: TRZ FLAGS,F.LVAR ;CLEAR THE LAST VAR FLAGS
TRZE FLAGS,F.LPAR+F.LOPP
ERR MISPC1 ;MISPLACED COMMA (MESSAGE 1)
TRO FLAGS,F.LPAR
COMMA1: CAMN STACK,STKST ;DL EMPTY?
ERR MISPC2 ;MISPLACED COMMA (MESSAGE 2)
MOVE SYMBOL,(STACK) ;GET LAST DELIMITER
LDB A,OPCPNT ;EXTRACT OPCODE
CAIN A,13 ;FJUMP
JRST POLCON
CAIN A,15 ;LEFT PAREN?
ERR NORPAR ;MISSING RIGHT PAREN
POP STACK,SYMBOL
MOVEM SYMBOL,PNS(PIND)
AOBJN PIND,COMMA1 ;KEEP AT IT
ERR PNSFUL
;ROUTINES TO EVALUATE THE POLISH STRING
;CALL PUSHJ PDP,PNSVAL
;BEFORE ENTRY, THE STACK SHOULD BE INITIALIZED
PNSVAL: MOVEI A,PNS ;GET BASE ADR OF PNS
HRRM A,PNSLOC ;STORE IN INDIRECT WORD
SETZ PIND, ;ZERO THE INDEX
PNSVL1: MOVE SYMBOL,@PNSLOC ;GET AN ITEM OF PNS
LDB A,OPCPNT ;GET THE OPCODE
PUSHJ PDP,@OPCODE(A) ;GO TO THE PROPER ROUTINE
AOJA PIND,PNSVL1 ;CONTINUE TIL DONE
;THESE ARE THE OPCODES USED BY ABACUS
OPCODE: PLUS ;0
MINUS ;1
MULT ;2
DIVIDE ;3
EXPON ;4
NEGAT ;5
OPDC ;6
CONCAL ;7
PCALL ;10
FRET ;11
REDYF ;12
FJUMP ;13
STORE ;14
DONE ;15
DOCALL ;16
.PLUS: 0
.EXPON: 4B5
.NEGAT: 5B5
.OPDC: 6B5
.CONCL: 7B5
.PCALL: 10B5
.FRET: 11B5
.REDYF: 12B5
.FJUMP: 13B5
.STORE: 14B5
.DONE: 15B5
.LPARN: 15B5
.DOCAL: 16B5
;THE FOLLOWING ROUTINES HANDLE ARITHMETIC OPERATIONS ON THE STACK
;AND ARE CALLED FROM PNSVAL
BCALC:
PLUS: POP STACK,A ;REMOVE 1ST FROM STACK
MOVE N,(STACK) ;MOVE 2ND FROM STACK
FADR N,A ;ADD THE TWO
MOVEM N,(STACK) ;AND PUT BACK IN STACK
POPJ PDP,
MINUS: POP STACK,A ;REMOVE FIRST ELEMENT
MOVE N,(STACK) ;GET SECOND ELEMENT
FSBR N,A ;SUBTRACT THE TWO
MOVEM N,(STACK)
POPJ PDP,
MULT: POP STACK,A ;REMOVE 1ST FROM STACK
MOVE N,(STACK) ;GET THE 2ND
FMPR N,A ;MULTIPLY THE TWO
MOVEM N,(STACK) ;AND STORE RESULT IN STACK
POPJ PDP,
DIVIDE: POP STACK,A ;GET DIVISOR
MOVE N,(STACK) ;GET DIVIDEND
FDVR N,A ;DIVIDE THE TWO
MOVEM N,(STACK) ;STORE BACK IN STACK
POPJ PDP,
EXPON: POP STACK,N1 ;PICK UP EXPONENT
POP STACK,N ;PICK UP BASE
PUSHJ PDP,EXP3.0 ;DO THE CALCULATION
PUSH STACK,N ;PUT RESULT ON STACK
POPJ PDP, ;RETURN
NEGAT: POP STACK,N ;PICK UP VALUE
MOVNS N ;NEGATE IT
PUSH STACK,N ;AND PUSH BACK ONTO STACK
POPJ PDP,
ECALC:
;THE FOLLOWING ROUTINES HANDLE OTHER STACK OPERATIONS
;AND ARE CALLED FROM PNSVAL
;OPDC PUSHES THE VALUE OF THE SPECIFIED VARIABLE ONTO THE STACK
OPDC: LSH SYMBOL,6 ;PNS ITEM IN "SYMBOL"
PUSHJ PDP,LABCHK ;LOOKUP THE LABLE
ERR UNDVAR
PUSH STACK,LABTAB+1(CNT) ;PUSH VALUE ONTO STACK
POPJ PDP,
;DOCALL PUSHES THE CURRENT DO VALUE ONTO THE STACK
DOCALL: PUSH STACK,DOREG1 ;PUSH DO LOOP VAL. ON STACK
POPJ PDP, ;RETURN
;CONCAL PUSHES A CONSTANT (NEXT WD IN PNS) ONTO THE STACK
CONCAL: AOJ PIND, ;ADVANCE PNS INDEX TO PICK UP CONSTANT
PUSH STACK,@PNSLOC ;PUSH CONSTANT ONTO STACK
POPJ PDP,
;PCALL PUSHES A PARAMETER SUPPLED TO A FUNCTION ON TO THE TOP OF
;THE STACK.
PCALL: PUSHJ PDP,PCALL1
PUSH STACK,(A)
POPJ PDP,
PCALL1: HRRZ A,LINK ;GET LINK
MOVE B,(A) ;GET WORD ADRESSED BY A
TRZN B,400000 ;IS BIT 18 SET?
JRST .+3 ;NO
HRRZ A,B ;USE THIS WORD TO REFERENCE
JRST PCALL1+1 ;CONTINUE TIL BIT 18 IS NOT SET
SUBI A,1(SYMBOL)
POPJ PDP,
FRET: POP STACK,SYMBOL ;SAVE THE RESULT
POP STACK,A ;GET JUMP CONTROL WORD
POP STACK,B ;GET PNS WORD
HRRM B,PNSLOC ;PLACE THIS ADR IN PNSLOC
SETZ PIND, ;RESET THE PNS INDEX
MOVE STACK,A ;MOVE JUMP CONTROL INTO STACK POINTER
POP STACK,A ;GET THE REDYF WORD
TRZ A,400000 ;CLEAR BIT 18
MOVEM A,LINK ;UPDATE LINK
PUSH STACK,SYMBOL ;PUT THE RESULT BACK IN STACK
POPJ PDP,
;REDYF PREPARES THE STACK FOR FUNCTION HANDLING
REDYF: MOVE SYMBOL,LINK ;GET CURRENT LINK
TRO SYMBOL,400000 ;SET BIT 18
PUSH STACK,SYMBOL ;PUSH REDYF WORD ONTO STACK
MOVEM STACK,LINK ;UP DATE LINK
POPJ PDP,
;FJUMP PERFORMS A FUNCTION JUMP
FJUMP: LSH SYMBOL,6 ;GET FUNCTION NAME
PUSHJ PDP,INTCHK ;IS IT AN INTRINSIC?
JRST FJUMP1 ;YES
PUSHJ PDP,FUNCHK ;IS IT USER DEFINED?
ERR UNDFUN ;NO
AOJ CNT,
LDB N,[POINT 6,@FNSTPT,5] ;GET # ARGS
PUSHJ PDP,FJUMP2 ;SEE IT DONE BELOW
LDB C,FNBPT1 ;GET # SOURCE WORDS FROM HEADER
ADDI CNT,(C) ;ADVANCE COUNT TO 1ST PNS WORD
MOVEI A,@FNSTPT ;GET THE ABS. ADR THERE
HRRM A,PNSLOC ;STORE IT IN RH OF PNSLOC
SETZ PIND, ;SET PNS INDEX TO 0
POPJ PDP,
FJUMP1: AOJ CNT,
LDB N,[POINT 6,FUNTAB(CNT),5]
PUSHJ PDP,FJUMP2 ;DO YOUR THING
JRST @FUNTAB(CNT) ;GO TO FUNCTION (RETURN TO PNSVL1)
FJUMP2: HRRZ B,LINK ;CALCULATE # PARAMETERS SUPPLIED
SUBI B,(STACK)
MOVNS B
CAME N,B ;DO THEY MATCH?
JRST FJUMP3 ;IN CORRECT NBER OF ARGS
MOVEI A,@PNSLOC ;GET LOCATION OF THIS PNS WORD
PUSH STACK,A ;PUSH IT ONTO STACK
PUSH STACK,LINK ;PUSH CURRENT LINT ONTO STACK
MOVEM STACK,LINK ;AND UP DATE LINK
POPJ PDP,
FJUMP3: SPEAK INCARG
MOVE N,B
ERR NUMSUP
;STORE STORES THE RESULT AT TOP OF STACK INTO A VARIABLE
STORE: HLLI SYMBOL, ;ZERO THE LEFT
MOVE N,(STACK) ;GET THE RESULT FROM THE STACK
MOVEM N,LABTAB+1(SYMBOL) ;STORE IN LABTAB
POPJ PDP,
;DONE DOES JUST THAT!!
DONE: POP PDP,A ;DUMMY UP A POPJ
POPJ PDP, ;DONE AT LAST!!!!!!!!!
;ROUTINE TO INPUT A SIXBIT LABLE INTO AC "SYMBOL"
;"CNT" THE MAXIMUM NUMBER OF CHARACTERS SHOULD BE SET BEFORE ENTRY
LABIN: MOVE BPT,[POINT 6,SYMBOL] ;SET UP BYTE POINTER
SETZ SYMBOL, ;ZERO THE DESTINATION AC
LABIN1: TLNN CHR,C.LETT+C.DIGI
JRST LABIN2
SOJL CNT,CPOPJ ;MORE THAN ALLOWED?
IDPB CHR,BPT ;STORE IN SYMBOL
PUSHJ PDP,CHRIN ;GET NEXT CHR
JRST LABIN1
LABIN2: AOS (PDP) ;FOR SKIP RETURN
JRST SSPAC1 ;SKIP SPACES AND RETURN
;ROUTINE TO LOOK UP LABLES AS VARIABLES
;CALL PUSHJ PDP,LABCHK
;ON ENTERING, LABLE IS LEFT JUSTIFIED IN "SYMBOL"
;NON-SKIP RETURN IF NOT FOUND -- "CNT" INDEXES NEXT FREE SPACE
;SKIP IF FOUND -- "CNT" INDEXES THE ENTRY
LABCHK: MOVN CNT,LABTOT ;NUMBER OF ITEMS IN TABLE
HRLZS CNT ;SET UP A CONTROL COUNT
LABCK1: CAMN SYMBOL,LABTAB(CNT) ;COMPARE THE TWO
JRST LABCK2 ;MATCH
ADD CNT,ONETWO ;INCREMENT COUNT
JUMPL CNT,LABCK1 ;TRY AGAIN IF MORE LEFT
POPJ PDP, ;NOT IN TABLE
LABCK2: HLLI CNT, ;ZERO OUT THE LEFT HALF
CPOPJ1: AOS (PDP)
POPJ PDP,
ONETWO: XWD 1,2 ;FOR INCREMENTING TWO WORD COUNTERS
;ROUTINE TO CHECK COMMANDS
;CALL PUSHJ PDP,COMCHK -- LABLE IN "SYMBOL" ON ENTRY
;SKIP RETURN IF NOT VALID
;NON-SKIP RETURN IF A COMMAND
COMCHK: HRLZI A,COMLEN ;SET UP A COUNTER
CAMN SYMBOL,COMTAB(A) ;COMPARE THE TWO
POPJ PDP, ;MATCH--NORMAL RETURN
ADD A,ONETWO ;ADVANCE COUNT
JUMPL A,COMCHK+1 ;TRY AGAIN IF MORE LEFT
AOS (PDP)
POPJ PDP, ;FOR SKIP RETURN
;TABLE OF ABACUS COMMANDS
;FIRST WORD IS SIXBIT COMMAND NAME
;SECOND WORD IS THE LOCATION OF THE COMMAND
;HANDLING ROUTINE
DEFINE COM (A,B)
<SIXBIT /'A'/
B
>
COMTAB: COM (TYPE,TYPE)
COM (TY,TYPE)
COM (TOTAL,TOTAL)
COM (T,TOTAL)
COM (SUBTOT,SUBTOT)
COM (S,SUBTOT)
COM (DISPLY,DISPLY)
COM (DIS,DISPLY)
COM (STOP,STOP)
IFN BYER,<
COM (BYE,BYE)
>
COM (CLRSUB,CLRSUB)
COM (CLRTOT,CLRTOT)
COM (FOR,FOR)
COM (DAYTIM,DAYTIM)
COM (DA,DAYTIM)
COM (PJOB,PJOBER)
COM (STATUS,STATS)
COM (STAT,STATS)
COM (BACKUP,BACKUP)
COM (BK,BACKUP)
COM (CNGSGN,CNGSGN)
COM (CS,CNGSGN)
COM (DEFINE,DEFINF)
COM (DEF,DEFINF)
COM (PRINT,PRINT)
COM (DELETE,DELETE)
COM (DEL,DELETE)
COM (RUNTIM,RNTIM)
COM (CONTIM,CONTIM)
;FILE HANDLING COMMANDS
IFN FILCAP,<
COM (RECALL,RECALL)
COM (STORE,STOREF)
COM (LIST,LISTER)
COM (HELP,HELP)
>
;DEBUGGING COMMANDS
IFN DEBUG,<
COM (CORUSE,CORUSE)
COM (PNS,PNSCHK)
COM (DDT,DDTST)
>
COMLEN=COMTAB-. ;LENGTH OF TABLE
;ROUTINE TO PROMPT USER WITH A "#"
;CALL PUSHJ PDP,PROMPT
PROMPT: TTCALL 14, ;THIS IS TO CLEAR A CONTROL O
JRST .+1
MOVEI C,"#"
TTCALL 1,C
JRST SPACEO
;ROUTINE TO FETCH A CHARACTER FROM TTY
;THE CALLING SEQUENCE IS:
; PUSHJ PDP,CHRIN
; NORMAL RETURN
;ON A NORMAL RETURN, AC 'CHR' IS OF THE FORM XWD FLAGS,SIXBIT VALUE
CHRIN: TTCALL 4,CHR ;ONE CHR FROM TTY
CAIN CHR,"&" ;LINE CONTINUATION?
JRST CHRIN1
CAIN CHR,"'" ;COMMENT TO FOLLOW?
JRST CHRIN2
CAIN CHR,TAB ;CONVERT TAB TO SPACES
MOVEI CHR,SPACE
CAIN CHR,CR ;CARRIAGE RETURN?
JRST CHRIN ;YES, SKIP OVER
CAIN CHR,LF ;LINE FEED?
MOVEI CHR,CR ;YES, CONVERT TO <CR>
HLL CHR,CHRTAB(CHR) ;GET FLAGS FROM LEFT
TRNE CHR,100
HRL CHR,CHRTAB-100(CHR) ;OR RIGHT OF CHARACTER TABLE
TLNE CHR,C.ILEG ;ILLEGAL?
ERR ILLCHR ;TOO BAD. . .
TLNE CHR,C.LOWC ;LOWER CASE
SUBI CHR,40 ;GETS CONVERTED TO UPPER
TLNN CHR,C.CR ;CONVERT TO SIXBIT UNLESS <CR>
SUBI CHR,40
TRNE FLAGS,F.DEFN ;DEFINING A FUNCTION?
PUSHJ PDP,STOSRC ;MEANS TO STORE SOURCE CODE
POPJ PDP, ;DONE SO RETURN
CHRIN1: TTCALL 4,CHR
CAIN CHR,CR ;READ OVER AND CHECK FOR <CR><LF>
JRST CHRIN1
CAIN CHR,LF
JRST CHRIN
ERR BADAND ;ALSO BAD USE OF "&"
CHRIN2: PUSH PDP,FLAGS ;SAVE FLAGS
TRZ FLAGS,F.DEFN ;TURN OFF DEFINE FLAG
PUSHJ PDP,THRUST ;SKIP TO END OF LINE
POP PDP,FLAGS ;RESTORE FLAGS
POPJ PDP, ;AND RETURN
;CHARACTER TABLE
CHRTAB: XWD C.ILEG,C.OTHR ;N @
XWD C.ILEG,C.LETT ;SOH A
XWD C.ILEG,C.LETT ;STX B
XWD C.ILEG,C.LETT ;ETX C
XWD C.ILEG,C.LETT ;EOT D
XWD C.ILEG,C.LETT ;ENQ E
XWD C.ILEG,C.LETT ;ACK F
XWD C.ILEG,C.LETT ;BEL G
XWD C.ILEG,C.LETT ;BS H
XWD C.SPAC,C.LETT ;HT I
XWD C.OTHR,C.LETT ;LF J
XWD C.ILEG,C.LETT ;VT K
XWD C.ILEG,C.LETT ;FF L
XWD C.CR,C.LETT ;CR M
XWD C.ILEG,C.LETT ;SO N
XWD C.ILEG,C.LETT ;SI O
XWD C.ILEG,C.LETT ;DEL P
XWD C.ILEG,C.LETT ;DC1 Q
XWD C.ILEG,C.LETT ;DC2 R
XWD C.ILEG,C.LETT ;DC3 S
XWD C.ILEG,C.LETT ;DC4 T
XWD C.ILEG,C.LETT ;NAK U
XWD C.ILEG,C.LETT ;SYN V
XWD C.ILEG,C.LETT ;ETB W
XWD C.ILEG,C.LETT ;CAN X
XWD C.ILEG,C.LETT ;EM Y
XWD C.ILEG,C.LETT ;SUB Z
XWD C.ILEG,C.LBRK ;ESC [
XWD C.ILEG,C.ILEG
XWD C.ILEG,C.RBRK ;GS ]
XWD C.ILEG,C.OPR ;RS ^
XWD C.ILEG,C.EQAL ;US _
XWD C.SPAC,C.OTHR ;SP '
XWD C.OTHR,C.LETL ;!
XWD C.OTHR,C.LETL ;"
XWD C.OTHR,C.LETL ;#
XWD C.OTHR,C.LETL ;$
XWD C.OTHR,C.LETL ;%
XWD C.OTHR,C.LETL ;&
XWD C.OTHR,C.LETL
XWD C.LPAR,C.LETL ;(
XWD C.RPAR,C.LETL ;)
XWD C.OPR,C.LETL ;*
XWD C.OPR,C.LETL ;+
XWD C.COMA,C.LETL ;,
XWD C.OPR,C.LETL ;-
XWD C.DOT,C.LETL ;.
XWD C.OPR,C.LETL ;/
XWD C.DIGI,C.LETL ;0
XWD C.DIGI,C.LETL ;1
XWD C.DIGI,C.LETL ;2
XWD C.DIGI,C.LETL ;3
XWD C.DIGI,C.LETL ;4
XWD C.DIGI,C.LETL ;5
XWD C.DIGI,C.LETL ;6
XWD C.DIGI,C.LETL ;7
XWD C.DIGI,C.LETL ;8
XWD C.DIGI,C.LETL ;9
XWD C.COLN,C.LETL ;:
XWD C.SEMI,C.LETL ;;
XWD C.LTR,C.ILEG ;<
XWD C.EQAL,C.ILEG ;=
XWD C.GTR,C.ILEG ;>
XWD C.OTHR,C.ILEG ;? DEL
;ROUTINE TO INPUT AND CHECK FOR SPACES
;CALL PUSHJ PDP,SSPACE TO INPUT NEXT CHARACTER UNTIL NON-BLANK
;CALL PUSHJ PDP,SSPAC1 TO CHECK CURRENT CHARACTER FOR BLANK AND INPUT NEXT
SSPACE: PUSHJ PDP,CHRIN ;INPUT A CHARACTER
SSPAC1: TLNN CHR,C.SPAC ;SPACE?
POPJ PDP,
JRST SSPACE
;FLOATING POINT NUMBER INPUT ROUTINE ADAPTED FROM BASIC VERSION 17
;CALL PUSHJ PDP,FLICON AFTER SETTING UP "CHR" AS THE FIRST CHARACTER
;ON RETURN -- N CONTAINS THE RESULT
;AC'S USED:
; CHR - FOR CHARACTERS
; N - RETURNS THE RESULT
; A, B, SYMBOL, D - WORK SPACE
; FLAGS - FOR FLAGS IN LEFT HALF
FLICON: SETZB N,SYMBOL ;CLEAR NUMBER AND SCALE FACTORS
MOVEI D,8 ;ONLY 8 DIGITS ARE SIGNIFICENT
HLLI FLAGS, ;CLEAR LEFT OF FLAGS
JRST .+2
FLIC1: PUSHJ PDP,CHRIN ;GET A CHARACTER
TLNN CHR,C.DIGI ;IS IT A DIGIT?
JRST FLIC2 ;NO
TLO FLAGS,F.NUM ;YES - REMEMBER WE'VE SEEN ONE
JUMPE N,FLIC1A ;SKIP LEADING ZEROS
SOJG D,FLIC1A ;COUNT THOSE DIGITS
AOJA SYMBOL,FLIC1B ;ADD TO SCALE FACTOR IF MORE THAN 8
FLIC1A: IMULI N,^D10 ;ACCUMULATE THE DIGIT
ADDI N,-20(CHR)
FLIC1B: TLNE FLAGS,F.DOT ;HAS A DOT BEEN SEEN?
SUBI SYMBOL,1 ;YES - DECREMENT THE SCALE FACTOR
JRST FLIC1 ;CONTINE ON TO NEXT CHARACTER
FLIC2: TLNN CHR,C.DOT ;MAYBE IT'S A DOT?
JRST FLIC3 ;NOT QUITE. . .
TLOE FLAGS,F.DOT ;YES - REMEMBER WE'VE SEEN ONE
ERR ONEDOT ;DON'T ALLOW TWO, THOUGH
JRST FLIC1 ;CONTINUE
FLIC3: MOVEI D,'E' ;SCIENTIFIC NOTATION?
CAIE D,(CHR)
JRST FLIC6 ;NOPE - MAYBE WE'RE DONE?
PUSHJ PDP,SSPACE ;GET NEXT IGNORING BLANKS
TLNN CHR,C.OPR ;OPERATOR (+ OR - ONLY)
JRST FLIC4+1 ;NO, MAYBE ITS A DIGIT
MOVEI D,(CHR)
CAIN D,'+' ;IS IT POSITIVE?
JRST FLIC4
CAIE D,'-' ;OR NEGATIVE?
JRST FLIC4+1 ;OR ASSUMED POSITIVE?
TLO FLAGS,F.MINN ;NOTE THE EVENT IF NEGATIVE
FLIC4: PUSHJ PDP,CHRIN ;GET NEXT
SETZ D,
TLNN CHR,C.DIGI ;IS IT A DIGIT?
ERR BADEDG ;BAD DIGIT AFTER E
IMULI D,^D10
ADDI D,-20(CHR)
PUSHJ PDP,CHRIN
TLNE CHR,C.DIGI
JRST .-4 ;CONTINUE TO BUILD THE EXPONENT
FLIC5: TLNE FLAGS,F.MINN ;IS IT NEGATIVE
MOVNS D ;YEP - MAKE IT THUS
ADD SYMBOL,D ;ADD EXPONENT TO SCALE FACTOR
FLIC6: TLNN FLAGS,F.NUM ;DID WE SEE A DIGIT?
ERR NODIGT ;TOO BAD
JUMPE N,SSPAC1 ;DONE IF ZERO
FLIC6A: MOVE A,N ;REMOVE TRAILING ZEROS IN "MANTISSA"
IDIVI A,^D10 ;SO THAT .1,.10,.100, ETC ARE THE
JUMPN B,FLIC6B ;SAME
MOVE N,A
AOJA SYMBOL,FLIC6A
FLIC6B: TLO N,233000 ;FLOAT N
FAD N,[0]
FLIC6C: CAIGE SYMBOL,^D15 ;SCALE UP IF >=10^15
JRST FLIC6D
SUBI SYMBOL,^D14 ;SUBTRACT 14 FROM SCALE FACTOR
FMPR N,D1E14 ;MULTIPLY BY 10^14
JRST FLIC6C ;AND LOOK AT SCALE AGAIN
FLIC6D: CAML SYMBOL,[EXP -^D4] ;SCALE DOWN IF <10^-4
JRST FLIC6E
ADDI SYMBOL,^D18 ;ADD 18 TO SCALE FACTOR
FMPR N,D1EM18 ;MULTIPLY BY 10^-18
JRST FLIC6D
FLIC6E: FMPR N,DECTAB(SYMBOL) ;SCALE N
TRNE FLAGS,F.OVER ;OVERFLOW?
ERR NUMOVR ;NUMBER OVERFLOWED
TRNE FLAGS,F.UNDR ;UNDERFLOW?
ERR NUMUND ;NUMBER UNDERFLOWED
JRST SSPAC1
;POWER OF 10 TABLE
D1EM18: OCT 105447113564 ;10^-18
D1EM4: OCT 163643334273 ;10^-4
OCT 167406111565
OCT 172507534122
OCT 175631463146
DECTAB: DEC 1.0 ;10^0
DEC 1.0E1
DEC 1.0E2
DEC 1.0E3
DEC 1.0E4
DEC 1.0E5
DEC 1.0E6
DEC 1.0E7
DEC 1.0E8
DEC 1.0E9
DEC 1.0E10
DEC 1.0E11
OCT 250721522451 ;10^12
OCT 254443023471
D1E14: OCT 257553630410 ;10^14
DECFIX: EXP 225400000000
FIXCON: EXP 233400000000
;ROUTINE TO PRINT SIXBIT WORD IN "SYMBOL"
;CALL PUSHJ PDP,SIXOUT -- IGNORES BLANKS
SIXOUT: MOVE BPT,[POINT 6,SYMBOL] ;SETUP BYTE POINTER
ILDB C,BPT ;GET A CHARACTER
JUMPE C,.+3 ;<SP>?
ADDI C,40 ;CONVERT TO SEVEN BIT
PUSHJ PDP,OUTCHR ;PUT IT OUT
TLNE BPT,770000 ;DONE?
JRST SIXOUT+1
POPJ PDP,
;ROUTINE TO PRINT OUT DEV:FILNAM.EXT [PROJ,PROG]
;CALL PUSHJ PDP,FILTYP
IFN FILCAP,<
FILTYP: SKIPN SYMBOL,OPENBK+1 ;GET SIXBIT DEVICE
JRST FILTY1 ;NONE SPECIFIED
PUSHJ PDP,SIXOUT ;PRINT IT
PUSHJ PDP,COLON ;FOLLOW UP WITH YOU KNOW WHAT
FILTY1: MOVE SYMBOL,FILNAM ;GET SIXBIT FILE NAME
PUSHJ PDP,SIXOUT
HLLZ SYMBOL,FILNAM+1 ;GET SIXBIT EXTENSION
JUMPE SYMBOL,FILTY2 ;NONE SPECIFIED
PUSHJ PDP,PERIOD ;SPIT OUT A DOT
PUSHJ PDP,SIXOUT
FILTY2: SKIPE A,FILDAT+3 ;GET PROJ-PROG NUMBER
JRST PPNOUT ;PRINT IT AND RETURN
POPJ PDP, ;NONE SPECIFIED SO RETURN
;ROUTINE TO PRINT [PROJ,PROG] IN STANDARD DEC FORM
;CALL PUSHJ PDP,PPNOUT
;AFTER MOVING THE VALUE INTO AC 'A'
PPNOUT: HLRZ N,A ;GET THE PROJECT
SPEAK [ASCIZ / [%O,/] ;AND PRINT IT
HRRZ N,A ;GET THE PROGRAMMER
SPEAK [ASCIZ /%O]/] ;AND PRINT IT TOO
POPJ PDP,
> ;END OF COND. ON FILCAP
;ROUTINE TO PRINT ALL USER DEFINED VARIABLES
;CALL PUSHJ PDP,PRTALV
PRTALV: MOVE B,LABTOT ;NUMBER OF VARIABLES
CAIG B,2 ;ANY USER DEFINED ONES?
JRST PRTAV1 ;NOPE
SPEAK VARTTL ;PRINT A TITLE FIRST
MOVNS B
HRLZS B
ADD B,ONETWO ;SKIP OVER PREDEFINED
ADD B,ONETWO ;VARIABLES (2)
PUSHJ PDP,PRTVAR
ADD B,ONETWO
JUMPL B,.-2
POPJ PDP,
PRTAV1: PUSH PDP,FLAGS ;SAVE FLAGS
TRZ FLAGS,F.FCHR ;FORCE OUTPUT TO TTY
SPEAK NOVARS
POP PDP,FLAGS ;RESTORE FLAGS
POPJ PDP,
;ROUTINE TO PRINT ALL USER DEFINED FUNCTIONS
;CALL PUSHJ PDP,PRTALF
PRTALF: SETZ CNT,
HRRZ A,FNSTPT ;GET STARTING LOC. OF FUNCTIONS
CAML A,FUNNXT ;ANY USER DEFINED ONES?
JRST PRTAF2 ;NOPE
SPEAK FUNTTL ;PRINT A TITLE FIRST
PRTAF1: MOVEI A,@FNSTPT ;GET ABSOLUTE ADR. OF NAME
CAML A,FUNNXT
POPJ PDP,
PUSHJ PDP,PRISRC ;PRINT THE DEFINITION
JRST PRTAF1 ;CONTINUE
PRTAF2: PUSH PDP,FLAGS
TRZ FLAGS,F.FCHR
SPEAK NOFUNS
POP PDP,FLAGS
POPJ PDP,
CRLF2: PUSHJ PDP,CRLF
CRLF: MOVEI C,15
PUSHJ PDP,OUTCHR
MOVEI C,12
PUSHJ PDP,OUTCHR
POPJ PDP,
TABOUT: MOVEI C,11 ;A TAB, WHAT ELSE?
JRST OUTCHR
SPACEO: MOVEI C,SPACE ;A SPACE
JRST OUTCHR
EQOUT: MOVEI C,"=" ;AN EQUAL SIGN
JRST OUTCHR
COLON: MOVEI C,":" ;A COLON, YOU DUMMY!
JRST OUTCHR
PERIOD: MOVEI C,"." ;WOULD YOU BELIEVE, A PERIOD?
JRST OUTCHR
NEGOUT: MOVEI C,"-" ;A NEGATIVE SIGN
JRST OUTCHR
ZEROUT: MOVEI C,"0" ;A ZERO
JRST OUTCHR
;ROUTINE TO PRINT DATE IN DEC FORMAT
;CALL PUSHJ PDP,DATE
DATE: CALLI A,14 ;GET DATE IN 12 BIT FORMAT
IDIVI A,^D31
MOVEI N,1(B)
PUSHJ PDP,DECPRO ;PUT OUT THE DAY
IDIVI A,^D12
MOVE SYMBOL,MONTAB(B) ;GET THE ASCII MONTH
PUSHJ PDP,SIXOUT ;AND PUT IT OUT
MOVEI N,^D64(A)
JRST DECPRO ;PUT OUT YEAR AND RETURN
MONTAB: SIXBIT /-JAN-/
SIXBIT /-FEB-/
SIXBIT /-MAR-/
SIXBIT /-APR-/
SIXBIT /-MAY-/
SIXBIT /-JUN-/
SIXBIT /-JUL-/
SIXBIT /-AUG-/
SIXBIT /-SEP-/
SIXBIT /-OCT-/
SIXBIT /-NOV-/
SIXBIT /-DEC-/
;ROUTINE TO PRINT OUT THE USER'S RUNTIME
RNTIME: SETZ A,
CALLI A,27
SUB A,INRNTM
IDIVI A,^D10 ;REMOVE THOUSANDTHS
IDIVI A,^D100 ;SECONDS TO A, HUNDREDTHS TO B
MOVE N,A ;OUTPUT THE SECONDS
PUSHJ PDP,DECPNT
PUSHJ PDP,PERIOD ;A PERIOD
MOVE N,B ;AND THE FRACTIONAL PART
PUSHJ PDP,DECPRO
SPEAK [ASCIZ / SEC./]
POPJ PDP,
CNTIME: CALLI A,23
SUB A,INCNTM
JRST .+2
TIME: CALLI A,23 ;GET THE TIME IN MILLISECONDS
IDIV A,[EXP ^D60000*^D60]
MOVE N,A
PUSHJ PDP,DECPRO ;PUT OUT THE HOUR
PUSHJ PDP,COLON ;FANCY IT UP
MOVE A,B
IDIVI A,^D60000
MOVE N,A
PUSHJ PDP,DECPRO ;PUT OUT THE MINUTES
PUSHJ PDP,COLON
MOVE N,B
IDIVI N,^D1000
PUSHJ PDP,DECPRO ;PUT OUT THE SECONDS
POPJ PDP,
;ROUTINE TO PRINT OUT DATE AND TIME
DATIM: PUSHJ PDP,DATE
PUSHJ PDP,TABOUT
PUSHJ PDP,TIME
JRST CRLF
;INTEGER PRINTING ROUTINES FOR VALUE IN "N"
;CALL PUSHJ PDP,DECPRO -- FOR DECIMALS WITH DESIRED LEADING ZEROS
;CALL PUSHJ PDP,DECPNT -- FOR DECIMALS
;CALL PUSHJ PDP,OCTPNT -- FOR OCTALS
DECPRO: CAIG N,^D9 ;DOES A ZERO LEAD IT OFF?
PUSHJ PDP,ZEROUT
DECPNT: SKIPA BPT,[12] ;"BPT" CONTAINS THE RADIX
OCTPNT: MOVEI BPT,10 ;FOR OCTAL PRINT RADIX
RDXPNT: IDIVI N,(BPT) ;CONVERT TO BASE IN "BPT"
HRLM N1,(PDP) ;SAVE REMAINDER IN LH PDL
SKIPE N ;DONE WHEN ZERO
PUSHJ PDP,RDXPNT ;KEEP AT IT
HLRZ C,(PDP) ;TAKE OFF PDL
ADDI C,60 ;CONVERT TO SEVENBIT ASCII
OUTCHR: TRNE FLAGS,F.FCHR ;OUTPUT TO TTY?
JRST OUTCR1 ;NOPE
TTCALL 1,C
POPJ PDP,
OUTCR1: MOVE WD,C ;OUTPUT THE CHARACTER
IFN FILCAP,<JRST PUTWD>
JRST OUTCHR+2
;FLOATING OUTPUT CONVERSION ROUTINE ADAPTED FROM BASIC V17
;CALL PUSHJ PDP,FLOCON
;ON ENTRY THE VALUE TO BE PRINTED IS IN "N"
;FLOCON USES AC'S A,B,C,CNT,SYMBOL,BPT,N,N1
FLOCON: PUSH PDP,B ;SAVE B
PUSH PDP,CNT ;SAVE CNT
PUSHJ PDP,FLOC1
POP PDP,CNT
POP PDP,B
POPJ PDP,
FLOC1: HLLI FLAGS,
SKIPGE N ;NEGATIVE?
TLO FLAGS,F.MINN ;YES SO NOTE IT
MOVMS N ;"A" CONTAINS THE NUMBER ON CALL
JUMPE N,ZEROUT ;SIMPLY PRINT A ZERO IF SUCH
FLOC2: MOVEI CNT,0 ;"CNT" CONTAINS THE SCALE FACTOR
FLOC2A: CAMG N,D1E14 ;SCALE IF >10^14
JRST FLOC2B
ADDI CNT,^D18 ;ADD 18 TO SCALE
FMPR N,D1EM18 ;AND MULTIPLY BY 10^-18
JRST FLOC2A
FLOC2B: CAML N,D1EM4 ;SCALE IF <10^-4
JRST FLOC2C
SUBI CNT,^D14 ;SUBTACT 14 FROM SCALE
FMPR N,D1E14 ;AND MULTIPLY BY 10^14
JRST FLOC2B
FLOC2C: MOVE B,[XWD -^D18,-^D4]
CAMLE N,DECTAB(B)
AOBJN B,.-1 ;LOOK UNTIL A GREATER ONE IS FOUND
HRRES B ;CLEAR LEFT HALF OF B PROPERLY
CAME N,DECTAB(B) ;FUDGE BY ONE IF EXACT MATCH
SUBI B,1
JUMPN CNT,FLOC3 ;NOT AN INTEGER IF WE SCALED
CAIGE B,^D8 ;CHECK B FOR 8 DIGIT INTEGER
CAIGE B,0
JRST FLOC3
CAML N,FIXCON ;IS IT 2^36?
JRST FLOC2D
MOVE N1,N
FAD N1,FIXCON ;INTEGER?
FSB N1,FIXCON
CAME N1,N
JRST FLOC3 ;NOT SO - LOST FRACTIONAL PART
FAD N,FIXCON ;SUCH SO FIX THE NUMBER
TLZ N,377400
FLOC2D: TLZ N,377000 ;IN CASE 27 BIT INTEGER
TLNE FLAGS,F.MINN ;NEGATIVE?
PUSHJ PDP,NEGOUT
JRST DECPNT ;PRINT IT OUT
FLOC3: SETZM NUMFLG ;ALL PURPOSE FLAG!
FDVR N,DECTAB(B) ;GET MANTISSA
FMPR N,DECTAB+5 ;MULTIPLY BY 10^5
TRNN N,7
SETOM NUMFLG
FADR N,FIXCON
TLZ N,377400 ;FIX IT
CAMGE N,[EXP ^D1000000]
JRST .+3
IDIVI N,^D10 ;ROUNDING MADE 7 DIGITS
ADDI B,1 ;MAKE IT 6 AGAIN
CAIL N,^D100000 ;ROUNDING MADE 5 DIGITS
JRST .+3
IMULI N,^D10 ;YES SO MAKE 6 AGAIN
SUBI B,1
ADDB B,CNT ;ADD TOGETHER THE PARTS OF SCALE
AOJ CNT,
CAILE CNT,6
SETZM NUMFLG
CAMG CNT,[OCT -7]
SETZM NUMFLG
SKIPN NUMFLG
JUMPL CNT,.+2 ;BETWEEN 10^-1 AND 10^6?
CAILE CNT,6
SKIPA CNT,[EXP 1]
PUSHJ PDP,FLOC5
TLNE FLAGS,F.MINN ;NEGATIVE?
PUSHJ PDP,NEGOUT
SKIPN NUMFLG
JUMPN CNT,FLOC4 ;SHOULD A POINT PRECEED NUMBER?
PUSHJ PDP,ZEROUT
PUSHJ PDP,PERIOD
SKIPN NUMFLG
JRST FLOC4
FLOC3A: AOJG CNT,FLOC3B ;PUT IN ZERO'S AFTER THE POINT
PUSHJ PDP,ZEROUT
JRST FLOC3A
FLOC3B: SETZ CNT,
FLOC4: SETZM NUMFLG
PUSHJ PDP,DNPRNT ;PRINT THE NUMBER
JUMPE B,CPOPJ ;ANY EXPONANT?
MOVSI SYMBOL,(SIXBIT / E+/)
SKIPGE B ;POSITIVE?
MOVSI SYMBOL,(SIXBIT / E-/)
PUSHJ PDP,SIXOUT
MOVM N,B ;THE DIGITS
JRST DECPNT
FLOC5: CAIL CNT,0
SETZM NUMFLG
MOVEI B,0
POPJ PDP,
DNPRNT: MOVEI BPT,-1 ;SIGNAL TRAILING ZERO UNLESS
JUMPE B,.+2 ;E NOTATION
MOVEI BPT,0
DNPRN0: IDIVI N,^D10 ;GET LAST DIGIT
JUMPE N,DNPRN1 ;IS IT FIRST
JUMPN N1,.+2 ;NON ZERO DIGIT
SKIPA N1,BPT ;NO SO STASH ZERO OR TRAIL ZERO
MOVEI BPT,0 ;YES SO TRAILING IS OVER
HRLM N1,(PDP) ;NO SO STASH DIGIT
PUSHJ PDP,DNPRN0 ;RECURSIVELY CALL
HLRE N1,(PDP) ;RESTORE THE DIGIT
JUMPGE N1,.+3 ;ORDINARY?
JUMPLE CNT,CPOPJ ;NO SO TRAIL ZERO AFTER "."?
MOVEI N1,0 ;NO SO STASH A ZERO
DNPRN1: MOVEI C,60(N1) ;PRINT DIGIT
PUSHJ PDP,OUTCHR
SOJN CNT,CPOPJ ;COUNT DIGITS
JRST PERIOD
;ROUTINE TO STORE THE SOURCE CODING OF A FUNCTION DEFINITION
;CALL PUSHJ PDP,STOSRC
STOSRC: TLNE CHR,C.CR ;CARRIAGE RETURN?
POPJ PDP,
IDPB CHR,C ;DEPOSIT THE BYTE (C IS BYTE POINTER)
TLNE C,770000 ;NEED TO ADVANCE A WORD?
POPJ PDP, ;NOPE
AOBJN FIND,.+2
PUSHJ PDP,CHKCOR
MOVEM WD,@FUNPNT ;SAVE THE WORD WE'VE BUILT
MOVE C,[POINT 6,WD] ;REINITIALIZE BYTE POINTER
SETZ WD, ;ZERO DESTINATION WORD
POPJ PDP, ;RETURN
;ROUTINE TO CHECK FOR SUFFICIENT CORE ON A FUNCTION DEFINITION
;LEFT HALF OF "FIND" IS SET TO THE NEGATIVE OF THE NUMBER OF WORDS
;REMAINING BEFORE AND EXPANSION IS NECESSARY
CHKCOR: PUSH PDP,A ;SAVE A AND B
PUSH PDP,B
HRRZI A,@FUNPNT ;GET CURRENT ADR IN FUNCTION TABLE
MOVE B,FUNMAX ;GET HIGHEST AVAILABLE ADR
CAILE B,(A) ;EXPANSION NEEDED?
JRST COROK ;NOPE
ADDI B,1 ;EXPAND BY 1K ONLY
CALLI B,11 ;CORE UUO
ERR NOCORE ;FAILED
HRRZ B,.JBREL ;UPDATE FUNMAX
MOVEM B,FUNMAX
COROK: SUB B,A ;SET UP LH OF "FIND"
MOVNS B
HRL FIND,B
POP PDP,B ;RESTORE A AND B
POP PDP,A
POPJ PDP,
;ROUTINE TO PRINT SOURCE CODE OF A FUNCTION
;CALL PUSHJ PDP,PRISRC
;ON ENTRY,"CNT" REFERENCES FUNCTION NAME IN TABLE
;WHEN DONE, "CNT" REFERENCES NEXT FUNCTION NAME
PRISRC: PUSHJ PDP,TABOUT ;PRINT A TAB
MOVE SYMBOL,@FNSTPT ;GET AND PRINT NAME OF FUNCTION
PUSHJ PDP,SIXOUT
AOJ CNT,
HRRZ B,@FNSTPT ;GET NUMBER OF PNS WORDS
LDB A,FNBPT1 ;GET NUMBER OF SOURCE WORDS
ADDI B,1(A)
ADDI B,(CNT)
MOVNS A
HRL CNT,A
AOJ CNT,
MOVE SYMBOL,@FNSTPT ;GET A WORD OF DEF AND PRINT IT
PUSHJ PDP,SIXOUT
AOBJN CNT,.-2
PRISC1: MOVE CNT,B ;ADVANCE CNT TO END
JRST CRLF
;ROUTINE TO CHECK FOR RESERVED WORDS AND PRINT APPROPRIATE MESSAGE
;CALL PUSHJ PDP,RESCHK
;ON ENTRY "SYMBOL" CONTAINS THE LABLE
;SKIP RETURN IF EVERYTHING OK
RESCHK: PUSH PDP,CNT ;SAVE C
PUSHJ PDP,COMCHK ;IS IT A COMMAND
JRST RESCK1
PUSHJ PDP,LABCHK ;IS IT A VARIABLE?
JRST .+2
JRST RESCK2
PUSHJ PDP,INTCHK ;IS IT AN INTRINSIC FUNCTION
JRST RESCK3
PUSHJ PDP,FUNCHK ;IS IT A USER DEFINED FUNCTION?
JRST .+4
SPEAK ISUFUN
POP PDP,CNT
POPJ PDP,
POP PDP,CNT
JRST CPOPJ1
RESCK1: SPEAK ISCOM
POP PDP,CNT
POPJ PDP,
RESCK2: SPEAK ISVAR
POP PDP,CNT
POPJ PDP,
RESCK3: SPEAK ISIFUN
POP PDP,CNT
POPJ PDP,
;ROUTINE TO LOOK UP A FUNCTION WHOSE NAME IS IN "SYMBOL"
;CALLING SEQUENCE:
; PUSHJ PDP,FUNCHK
; NOT FOUND RETURN
; NORMAL RETURN (AC 'CNT' REFERENCES THE FUNCTION NAME)
FUNCHK: SETZ CNT,
MOVE A,FUNNXT ;GET LOC OF NEXT FUNCTION
TRNE FLAGS,F.DEFN ;HAVE TO FUDGE IF DEFINING
SUBI A,1
FUNCK1: CAIG A,@FNSTPT ;IS THIS THE END OF TABLE?
POPJ PDP, ;YES--FUNCTION NOT FOUND
CAMN SYMBOL,@FNSTPT ;CHECK NAME
JRST CPOPJ1 ;MATCH--FUNCTION FOUND
AOJ CNT, ;ADVANCE TO HEADER+1
HRRZ B,@FNSTPT ;GET # PNS WORDS
LDB D,FNBPT1 ;GET # SOURCE WORDS
ADD B,D
ADDI CNT,1(B) ;ADVANCE CNT TO NEXT FUNCTION
JRST FUNCK1 ;AND CONTINUE
;ROUTINE TO CRUNCH CORE AFTER A FUNCTION DELETEION
;CALL PUSHJ PDP,CRUNCH
CRUNCH: MOVE A,FUNMAX ;MAX FUNCTION LOCATION
SUBI A,^D1024 ;1K OF CORE
CAMG A,FUNNXT ;CAN WE DO IT?
POPJ PDP, ;NOPE
CALLI A,11 ;CORE UUO
ERR NOCRUN
HRRZ A,.JBREL ;NEW MAXIMUM LOCATION
MOVEM A,FUNMAX
JRST CRUNCH+1
OPCPNT: POINT 6,SYMBOL,5 ;POINTER FOR OPCODES
SRCPNT: POINT 6,WD ;POINTER TO SOURCE WORDS
;ROUTINE TO DELETE ALL VARIABLES
;CALL PUSHJ PDP,DELALV
DELALV: MOVE B,LABTOT
CAIG B,2
JRST DELAV1 ;NO VARIABLES DEFINED
MOVEI CNT,2 ;KEEP 2 PREDEFINED
MOVEM CNT,LABTOT
MOVNS B
HRLZS B
ADD B,ONETWO ;SKIP OVER 2 PREDEFINED
ADD B,ONETWO
MOVE SYMBOL,LABTAB(B) ;PRINT NAME OF THAT DELETED
SPEAK DELMSG
ADD B,ONETWO
JUMPL B,.-3
POPJ PDP,
DELAV1: SPEAK NOVARS
POPJ PDP,
;ROUTINE TO DELETE ALL FUNCTIONS
;CALL PUSHJ PDP,DELALF
DELALF: HRRZ CNT,FNSTPT ;GET START OF FUNCTION TABLE
CAML CNT,FUNNXT ;ANY DEFINED?
JRST DELAF2 ;NOPE
SETZ CNT,
MOVEI A,@FNSTPT
CAML A,FUNNXT
JRST DELAF1 ;DONE WITH PRINTING NAMES
MOVE SYMBOL,@FNSTPT ;GET THE NAME
SPEAK DELMSG
AOJ CNT,
HRRZ A,@FNSTPT
LDB B,FNBPT1
ADD A,B
ADDI CNT,1(A)
JRST DELALF+4 ;CONTINUE TO NEXT FUNCTION
DELAF1: HRRZ CNT,FNSTPT
MOVEM CNT,FUNNXT
JRST CRUNCH ;TRY TO CRUNCH CORE
DELAF2: SPEAK NOFUNS ;NONE DEFINED
POPJ PDP,
;ROUTINE TO DELETE A PARTICULAR FUNCTION WHOSE NAME IS IN "SYMBOL"
;CALL PUSHJ PDP,DELFN
;SKIPS IF SUCCESSFUL
DELFN: MOVEI A,@FNSTPT
AOJ CNT,
HRRZ B,@FNSTPT ;GET # PNS WORDS
LDB D,FNBPT1 ;GET # SOURCE WORDS
ADDI D,1(B)
ADD CNT,D
HRLI A,@FNSTPT
ADDI D,2
SUB D,FUNNXT
MOVNM D,FUNNXT
BLT A,@FUNNXT
AOS FUNNXT
PUSHJ PDP,CRUNCH ;TRY TO CRUNCH CORE
POPJ PDP,
;ROUTINE TO SCAN A TTY LINE TO PICK UP FUNCTION AND/OR VARIABLE
;NAMES AS ARGUMENTS TO THE FOLLOWING COMMANDS:
; PRINT,DELETE,STORE,RECALL,LIST,REMOVE
;CALLING SEQUENCE:
; PUSHJ PDP,GETARG
; ERROR RETURN (NO ARGUMENTS SEEN)
; NORMAL RETURN
;GETARG SETS THE FLAGS F.ALF AND F.ALV UPON SEEING THE ARGUMENTS
;'ALLFUN' AND 'ALLVAR' RESPECTIVELY
;THE ARGUMENTS ARE STORED BEGINNING AT LOCATION DUMARG WITH
;THE RIGHT HALF OF AC 'A' CONTAINING THE NUMBER OF ITEMS IN THE TABLE
GETARG: SETZM DUMARG ;ZERO IT IN CASE QUICK RETURN
TRZ FLAGS,F.ALF+F.ALV ;CLEAR FLAGS
MOVSI A,-MAXARG ;SET UP AOBJN WORD
TLNE CHR,C.TERM ;ANYTING TYPED?
POPJ PDP, ;NO, ERROR RETURN
GETAG1: TLNN CHR,C.LETT ;MUST BEGIN WITH LETTER
ERR LETOLY
MOVEI CNT,6 ;6 CHRS MAXIMUM
PUSHJ PDP,LABIN
JRST LABLON ;6 CHRS MAXIMUM
CAMN SYMBOL,ALLFUN ;CHECK SPECIAL ARGS
JRST GETAG3
CAMN SYMBOL,ALLVAR
JRST GETAG4
CAIGE CNT,1 ;5 CHRS ONLY NOW
JRST LABLON
HRRZ B,A ;GET # CURRENTLY IN TABLE
CAMN SYMBOL,DUMARG-1(B) ;CHECK FOR DUPLICATION
JRST GETAG2 ;SINCE WE'VE GOT IT, SKIP
SOJG B,.-2
MOVEM SYMBOL,DUMARG(A) ;SAVE THE ARG
AOBJN A,.+2
ERR TOCMAG ;TOO MANY ARGUMENTS
GETAG2: TLNE CHR,C.COMA ;COMMA TO SHOW NEXT ARG
JRST .+4
SETZM DUMARG(A) ;SHOW END OF TABLE
AOS (PDP)
POPJ PDP,
PUSHJ PDP,SSPACE ;YES, SO SKIP COMMA
JRST GETAG1
GETAG3: TROA FLAGS,F.ALF ;SET ALLFUN SEEN FLAG
GETAG4: TRO FLAGS,F.ALV ;OR ALLVAR SEEN FLAG
JRST GETAG2 ;AND DO AS USUAL
;ROUTINE TO CHECK FOR A 'YES' OR 'NO' ANSWER
;CALLING SEQUENCE:
; PUSHJ PDP,YESNO
; NO RETURN
; YES RETURN
IFN FILCAP,<
YESNO: PUSH PDP,SYMBOL ;SAVE SYMBOL
PUSHJ PDP,THRUST ;KILL OFF REST OF LINE
PUSHJ PDP,SSPACE ;GET 1ST CHARACTER
MOVEI CNT,3 ;3 CHARACTERS MAX
PUSHJ PDP,LABIN ;GET ANSWER
JRST YESN1 ;TOO LONG
CAME SYMBOL,NO ;NO?
JRST .+3 ;GUESS NOT
POP PDP,SYMBOL ;RESTORE SYMBOL
JRST THRUST ;KILL LINE AND RETURN
CAME SYMBOL,YES ;YES?
JRST YESN1 ;BAD ANSWER
POP PDP,SYMBOL ;RESTORE SYMBOL
AOS (PDP) ;FOR SKIP RETURN
JRST THRUST ;KILL OFF LINE AND RETURN
YESN1: SPEAK BADANS
JRST YESNO+1
> ;END OF COND. ON FILCAP
;ROUTINE TO SCAN DUMARG FOR THE LABLE IN AC "SYMBOL" AND
;SET THE ENTRY TO -1 IF FOUND
;CALL PUSHJ PDP,DUMONE
DUMONE: SETZ C,
SKIPN A,DUMARG(C) ;SCAN TABLE
POPJ PDP, ;NOT FOUND
CAME SYMBOL,A ;IS IT THIS ONE
AOJA C,DUMONE+1 ;NOPE
SETOM DUMARG(C) ;YES
POPJ PDP,PDP ;RETURN
;ROUTINE TO SET UP FOR STORE AND DELETE TO DTA'S
;CALL PUSHJ PDP,DTAFIL
;DTAFIL SETS THE FLAG F.DTA AND THEN SETS UP A FILE NAME OF THE FORM:
; ###ABS.TMP WHRE ### ARE 3 DECIMAL DIGITS OF THE USER'S JOB NUMBER
IFN FILCAP,<
DTAFIL: MOVEI CNT,3 ;3 DECIMAL DIGITS ONLY
CALLI A,30 ;GET JOB NUMBER
IDIVI A,12 ;DIVIDE BY 10 TO MAKE DECIMAL
ADDI B,20 ;DIGITS--CONVERT TO SIXBIT
LSHC B,-6 ;AND BUILD NAME INTO AC 'C'
SOJG CNT,.-3
HRRI C,(SIXBIT /ABS/)
MOVEM C,ABSTMP ;SAVE THE TMP NAME
POPJ PDP,
> ;END OF COND. ON FILCAP
;ROUTINE TO SCAN A TTY LINE FOR FILE SELECTION INFO
;CALL PUSHJ PDP,FILE
;FILE RETURNS WITH THE FOLLOWING INFORMATION
; OPENBK+1 (SIXBIT DEVICE NAME -- DEFAULT IS 'DSK')
; FILDAT (SIXBIT FILE NAME -- DEFAULT IS 'ABACUS')
; FILDAT+1 (SIXBIT FILE EXTENSION -- DEFAULT IS 'STO')
; FILDAT+2 (PROTECTION IN PROPER BITS -- DEFAULT IS 0)
; FILDAT+3 (PPN -- DEFAULT IS [SELF])
IFN FILCAP,<
FILE: MOVSI A,(SIXBIT /DSK/) ;DEFAULT DEVICE
MOVEM A,OPENBK+1 ;STORE IN OPEN BLOCK PLUS 1
MOVE A,CUSP ;DEFAULT FILNAM
MOVEM A,FILDAT ;STORE IN FILDAT
MOVSI A,(SIXBIT /STO/) ;DEFAULT EXT
MOVEM A,FILDAT+1 ;STORE IN FILDAT+1
SETZM FILDAT+2 ;ZERO PROTECTION
SETZM FILDAT+3 ;ZERO PPN FOR DEFAULT
MOVEI CNT,6 ;6 CHARACTERS IN DEV OR FILNAM
PUSHJ PDP,LABIN ;GET SIXBIT LABLE
ERR LNGDEV
TLNN CHR,C.COLN ;COLON TO SHOW DEVICE?
JRST FILE1 ;NO
JUMPN SYMBOL,.+2 ;ANY SPECIFIED?
ERR NODEV
MOVEM SYMBOL,OPENBK+1 ;STORE IN OPEN BLOCK PLUS 1
PUSHJ PDP,SSPACE ;GET NEXT CHARACTER
MOVEI CNT,6 ;6 CHARACTERS IN FILNAM
PUSHJ PDP,LABIN ;GET THE LABLE
ERR LNGFIL
FILE1: JUMPN SYMBOL,.+4 ;ANY SPECIFIED?
TLNE CHR,C.DOT ;NO, BUT DID THEY DOT IT
ERR NOFILE
JRST FILE3
MOVEM SYMBOL,FILDAT ;STORE FILENAME IN FILDAT
TLNE CHR,C.DOT
JRST FILE2 ;YES SO GET EXTENSION
SETZM FILDAT+1 ;NO SO ZERO OUT EXTENSION
JRST FILE3
FILE2: PUSHJ PDP,SSPACE ;GET NEXT CHR
MOVEI CNT,3 ;3 CHARACTERS IN EXTENSION
PUSHJ PDP,LABIN
ERR LNGEXT
MOVEM SYMBOL,FILDAT+1
FILE3: TLNE CHR,C.LTR ;PROTECTION NEXT?
PUSHJ PDP,FILPRO ;YES SO GO GET IT
TLNN CHR,C.LBRK ;'[' TO SHOW PPN NEXT?
POPJ PDP, ;NO SO WE'RE ALL DONE
PUSHJ PDP,FILPPN ;YES SO GO GET IT
TLNE CHR,C.LTR ;CHECK PROTECTION AGAIN IN CASE
PUSHJ PDP,FILPRO
POPJ PDP, ;DONE IN EITHER CASE
;ROUTINE TO INPUT OCTAL NUMBER UNTIL A DELIMITER
;CALL PUSHJ PDP,OCTIN
;NOTE--OCTIN INPUTS THE FIRST CHARACTER
;RETURN IS ALWAYS TO NEXT LOCATION
;WITH RESULT IN AC "N"
OCTIN: SETZ N,
PUSHJ PDP,SSPACE
TLNN CHR,C.DIGI ;IS IT A DIGIT?
POPJ PDP, ;NO SO DONE
MOVEI CHR,(CHR) ;GET RIGHT HALF
CAIL CHR,'0' ;IS IT IN OCTAL RANGE?
CAILE CHR,'7'
ERR NONOCT
IMULI N,10
ADDI N,-20(CHR)
PUSHJ PDP,CHRIN
JRST OCTIN+2
FILPRO: PUSHJ PDP,OCTIN ;GET THE OCTAL NUMBER
CAILE N,777 ;IN PROPER RANGE?
ERR LNGPRO
TLNN CHR,C.GTR ;.GT. SIGN MUST END THE PROT. CODE
ERR NOGTR
PUSHJ PDP,SSPACE
LSH N,^D27 ;SHIFT OVER PROTECTION
MOVEM N,FILDAT+2 ;AND STORE IN FILDAT+2
POPJ PDP,
FILPPN: PUSHJ PDP,OCTIN ;GET PROJECT NUMBER
CAIL N,400000 ;MUST BE LESS THAN 400000
ERR PPNLON
HRLZM N,FILDAT+3 ;SAVE IT IN PROPER PLACES
TLNN CHR,C.COMA ;COMMA TO SEPARATE PROJ AND PROG?
ERR ILLPRJ
PUSHJ PDP,OCTIN ;GET PROGRAMMER NUMBER
CAIL N,400000
ERR PPNLON
TLNN CHR,C.RBRK ;']' TO END PPN?
ERR ILLPRG
HRRM N,FILDAT+3
JRST SSPACE ;GET NEXT NON BLANK AND RETURN
;ROUTINE TO CHECK DEVICE FOR THE FOLLOWING CHARCTERISTICS
; 1) EXISTANCE
; 2) AVAILABILITY TO THIS JOB
; 3) LEGALITY OF BINARY MODE
;CALL PUSHJ PDP,DEVCHK
;ON RETURN THE DEVCHR WORD IS IN AC 'A'
DEVCHK: MOVE A,OPENBK+1 ;GET DEVICE NAME
CALLI A,4 ;DEVCHR CALLI
JUMPN A,.+2
ERR NOTDEV ;NO SUCH DEVICE
TRNN A,10000 ;IS BINARY MODE 13 LEGAL?
ERR BADMOD
TLNN A,DV.AVL ;IS DEVICE AVAILABLE?
ERR NOTAVL ;NOPE
POPJ PDP,
> ;END OF COND. ON FILCAP
;ROUTINE TO CHECK PROPER USE OF 'ON' BEFORE FILE SPECIFICATION
;CALL PUSHJ PDP,CHKON
CHKON: MOVEI CNT,2 ;2 CHARACTERS ONLY
PUSHJ PDP,LABIN
ERR NOON
CAME SYMBOL,ON
ERR NOON
POPJ PDP,
;ROUTINE TO OPEN THE INPUT CHANNAL AND LOOK UP THE FILE
;CALL PUSHJ PDP,OPENI
;NON-SKIP RETURN IF FILE NOT FOUND
IFN FILCAP,<
OPENI: MOVEI B,MODE ;SET UP THE OPEN BLOCK
MOVEM B,OPENBK ;OPENBK: MODE
MOVEI B,IBUF ;------- SIXBIT /DEVICE/
MOVEM B,OPENBK+2 ;------- XWD 0,IBUF
OPEN CHANI,OPENBK ;DO THE OPEN
ERRF INDER ;CAN'T
MOVE B,FILBLT ;GET THE FILE INFO
BLT B,FILNAM+3
SETZM OLDFIL ;ZERO IN CASE FILE NOT FOUND
LOOKUP CHANI,FILNAM ;LOOK UP THE FILE
POPJ PDP, ;FILE NOT FOUND
MOVE B,FILNAM+2 ;GET OLD PROT AND CREATION DATE
MOVEM B,OLDFIL ;AND SAVE IT
AOS (PDP) ;FILE FOUND SO SKIP
POPJ PDP,
;ROUTINE TO OPEN THE OUTPUT CHANNAL AND ENTER THE FILE
;CALL PUSHJ PDP,OPENO
OPENO: MOVEI B,MODE ;SET UP OPEN BLOCK
MOVEM B,OPENBK
MOVEI B,OBUF
HRLZM B,OPENBK+2
OPEN CHANO,OPENBK
ERRF OUTDER ;CAN'T OPEN FILE
TLNN A,DV.DTA ;DECTAPE?
JRST OPENO1 ;NOPE
TRO FLAGS,F.DTA
MOVE B,ABSTMP ;GET TMP FILE NAME
MOVEM B,FILNAM
MOVSI B,(SIXBIT /TMP/)
MOVEM B,FILNAM+1
SETZM FILNAM+2
SETZM FILNAM+3
JRST OPENO2
OPENO1: MOVE B,FILBLT
BLT B,FILNAM+3
OPENO2: SKIPN A,OLDFIL ;GET OLD PROT,CREATION IF ANY
HRLZI A,STDPRO ;NONE SO USE STANDAR PROTECTION
LDB B,[POINT 27,A,35] ;KEEP OLD CREATION IF ANY
DPB B,[POINT 27,FILNAM+2,35]
LDB B,[POINT 9,A,8] ;GET OLD PROT IF ANY
SKIPN FILDAT+2 ;DID THEY SPECIFY PROTECTION?
DPB B,[POINT 9,FILNAM+2,8] ;NOPE
ENTER CHANO,FILNAM ;ENTER THE FILE
JRST NOOFIL ;CAN'T
POPJ PDP, ;RETURN
;ROUTINE TO MOVE FUNCTION LOCATIONS DOWN IN CORE TO PROVIDE
;ROOM FOR I/O BUFFERS
;CALL PUSHJ PDP,MDOWN
;ONE ENTRY AC 'B' CONTAINS THE NUMBER OF FREE WORDS REQUIRED
MDOWN: MOVE A,FUNNXT ;SET UP A POP POINTER
SUBI A,1
ORCMI A,777777
ADDB B,FUNNXT
MOVE C,.JBREL
CAMGE B,C
JRST MDOWN1
ADDI C,2000 ;EXPAND BY 1 K
CALLI C,11
ERRF NOBUFC
MOVE C,.JBREL
MOVEM C,FUNMAX
JRST .-7
MDOWN1: SUBI B,1
HRR C,FNSTPT
MDOWN2: CAILE C,(A)
JRST MDOWN3
POP A,(B)
SOJA B,MDOWN2
MDOWN3: ADDI B,1
HRRM B,FNSTPT
POPJ PDP,
;ROUTINE TO MOVE FUNCTION LOCATIONS UP IN CORE TO RECLAIM I/O
;BUFFER SPACE
;CALL PUSHJ PDP,MBACK
MBACK: HLRZ A,.JBSA ;SET UP BLT WORD
HRL A,FNSTPT
HLRZ B,.JBSA
HRRZ D,FNSTPT
SUB B,D
ADDB B,FUNNXT
HRRM A,FNSTPT
HRRZM A,.JBFF
BLT A,-1(B)
JRST CRUNCH
;ROUTINE TO INPUT A BYTE FROM FILE INTO AC 'WD'
;CALLING SEQUENCE:
; PUSHJ PDP,GETWD
; EOF RETURN
; NORMAL RETURN
GETWD: SOSGE IBUF+2
JRST GETBUF
ILDB WD,IBUF+1
XORM WD,PARWD ;FOR PARITY CHECK
AOS (PDP)
POPJ PDP,
GETBUF: IN CHANI,
JRST GETWD
GETSTS CHANI,WD
TRNN WD,74B23
JRST GETBF1
ERRF INPERR ;INPUT ERROR!!!!!!!!!
GETBF1: TRNE WD,1B22 ;EOF?
POPJ PDP,
JRST GETBUF
;ROUTINE TO OUTPUT A BYTE FROM AC 'WD' TO THE FILE
;CALLING SEQUENCE:
; PUSHJ PDP,PUTWD
; NORMAL RETURN
PUTWD: SOSG OBUF+2 ;ADVANCE BYTE COUNTER
JRST PUTBUF ;OUTPUT A BUFFER FULL
PUTER: IDPB WD,OBUF+1 ;INCREMENT AND DEPOSITE
POPJ PDP, ;RETURN
PUTBUF: OUT CHANO, ;PUT IT ALL OUT
JRST PUTER ;NICE -- NO ERRORS
ERRF OUTERR ;OUTPUT ERROR!!!!!!!!!
;ROUTINE TO CLOSE THE FILES
;CALL PUSHJ PDP,CLOSF
CLOSF: CLOSE CHANI, ;CLOSE INPUT CHANNAL
CLOSE CHANO, ;AND OUTPUT CHANNAL
STATZ CHANO,740000 ;ANY ERRORS ON LAST CLOSE?
ERRF OUTERR
TRNN FLAGS,F.DTA ;DEVICE DTA?
JRST CLOSF2 ;NOPE
MOVE B,FILBLT
BLT B,FILNAM+3 ;GET FILE INFO
LOOKUP CHANI,FILNAM ;LOOKUP OLD FILE
JRST CLOSF1 ;NOT FOUND
LDB A,CREDAT ;GET CREATION DATE
SETZM FILNAM
RENAME CHANI,FILNAM ;DELETE THE FILE
JRST DELERR ;HUH??
CLOSF1: CLOSE CHANI,
MOVE B,ABSTMP ;GET TMP FILE INFO AGAIN
MOVEM B,FILNAM
MOVSI B,(SIXBIT /TMP/)
MOVEM B,FILNAM+1
LOOKUP CHANO,FILNAM ;LOOKUP THE TMP FILE (DAMN DTA'S)
JRST RENERR ;HUH????
CLOSE CHANO, ;DTA'S MUST CLOSE BEFORE RENAME
MOVE B,FILBLT ;GET OLD FILE NAME
BLT B,FILNAM+3
DPB A,CREDAT ;KEEP OLD CREATION DATE
RENAME CHANO,FILNAM ;RENAME THE TMP FILE
JRST RENERR
CLOSE CHANO, ;CLOSE THE FILE
CLOSF2: RELEASE CHANI, ;RELEASE BOTH CHANNALS
RELEASE CHANO,
JRST MBACK ;RECLAIM BUFFER SPACE AND RETURN
> ;END OF COND. ON FILCAP
;ROUTINE TO STORE A FUNCTION DEFINITION ON THE OUTPUT FILE
;CALL PUSHJ PDP,STOFUN
;BEFORE ENTRY, A LOOKUP IS DONE ON THE FUNCTION NAME IN AC 'SYMBOL'
;SO THAT AC 'CNT' REFERENCES THE FUNCTION NAME VIA A BASE OF
;FNSTPT. STOFUN THEN OUTPUTS THE FUNCTION, CALCULATES AND OUTPUTS
;A PARITY WORD, AND THEN PRINTS AN OK MESSAGE.
IFN FILCAP,<
STOFUN: PUSH PDP,WD ;SAVE WD
PUSH PDP,PARWD ;SAVE PARWD
MOVE WD,SYMBOL ;GET FUNCTION NAME
AOJ CNT, ;ADVANCE CNT TO HEADER WORD
HRRZ B,@FNSTPT ;GET # PNS WORDS IN DEFINTION
LDB A,FNBPT1 ;AND # SOURCE WORDS
ADDI A,2(B) ;COMBINE AND ADD TWO EXTRA
;FOR HEADER AND PARITY WORD
MOVNS A ;SET UP AN AOBJN WORD
HRL CNT,A ;IN AC 'CNT'
SETZM PARWD ;CLEAR PARITY WORD
STOFN1: XORM WD,PARWD ;BUILD PARITY
PUSHJ PDP,PUTWD ;OUTPUT A WORD
MOVE WD,@FNSTPT ;GET NEXT WORD OF DEFINTION
AOBJN CNT,STOFN1 ;LOOP THROUGH TIL DONE
MOVE WD,PARWD ;GET AND OUTPUT THE PARITY WORD
PUSHJ PDP,PUTWD
SPEAK STOMSG ;TELL THEM EVERYTHINGS OK
POP PDP,PARWD ;RESTORE PARWD
POP PDP,WD ;AND WD
POPJ PDP, ;RETURN
;ROUTINE TO STORE A VARIABLE DEFINITION ON THE OUTPUT FILE
;CALL PUSHJ PDP,STOVAR
;BEFORE ENTRY, A LOOKUP IS DONE ON THE VARIABLE NAME IN AC 'SYMBOL'
;SO THAT AC 'CNT' REFERENCES THE VARIABLE NAME VIA A BASE OF LABTAB
;STOVAR THEN OUTPUTS THE VARIABLE, CALCULATES AND OUTPUTS A PARITY WORD
;AND THEN PRINTS AN OK MESSAGE.
STOVAR: PUSH PDP,WD ;SAVE WD
PUSH PDP,PARWD ;AND PARWD
MOVE WD,SYMBOL ;GET VARIABLE NAME
TRO WD,1 ;SET BIT 35 TO SHOW VARIABLE
MOVEM WD,PARWD ;SET UP PARITY WORD
PUSHJ PDP,PUTWD ;PUT OUT THE NAME
MOVE WD,LABTAB+1(CNT) ;GET THE VALUE
XORM WD,PARWD ;BUILD PARITY
PUSHJ PDP,PUTWD ;PUT OUT THE VALUE
MOVE WD,PARWD ;GET AND OUTPUT THE PARITY WORD
PUSHJ PDP,PUTWD
SPEAK STOMSG ;TELL THEM SO
POP PDP,PARWD ;RESTORE PARWD
POP PDP,WD ;AND WD
POPJ PDP,
;ROUTINE TO SKIP OVER OR PASS ON TO THE OUTPUT FILE A DEFINITION
;BEING READ IN FORM THE INPUT FILE
;CALLING SEQUENCES:
; PUSHJ PDP,PASSDF (TO PASS ON THE DEFINITION)
; PUSHJ PDP,SKIPDF (TO SKIP OVER THE DEFINITION)
;ON ENTRY, AC 'WD ' CONTAINS THE NAME OF THE DEFINITION TO BE
;OPERATED ON. IF BIT 35 OF AC 'WD' IS ON, THE DEFINTION IS A VARIABLE.
PASSDF: TRO FLAGS,F.PASS ;SET OUTPUT FLAG
PUSHJ PDP,PUTWD ;OUTPUT THE NAME
JRST .+2
SKIPDF: TRZ FLAGS,F.PASS ;CLEAR OUTPUT FLAG
MOVEI A,2 ;ASSUME ITS A VARIABLE
TRNE WD,1 ;WERE WE RIGHT?
JRST SKIPD2 ;YES
PUSHJ PDP,GETWD ;NO, ITS A FUNCTION -- GET HEADER WORD
ERRF BADEOF
HRRZ B,WD ;GET # OF PNS WORDS
LDB A,[POINT 12,WD,17] ;AND # SOURCE WORDS
ADDI A,1(B)
SKIPD1: TRNE FLAGS,F.PASS ;OUTPUT OR NOT?
PUSHJ PDP,PUTWD ;YES
SKIPD2: PUSHJ PDP,GETWD ;GET A WORD OF DEFINITION
ERRF BADEOF ;BAD END TO FILE
SOJG A,SKIPD1
TRNE FLAGS,F.PASS ;OUTPUT OR NOT?
PUSHJ PDP,PUTWD ;AND PASS ON THE PARITY
SKIPN PARWD ;DOES THE PARITY CHECK
POPJ PDP, ;YES, SO RETURN
ERRF PARERR ;NOPE, SOMETHING'S SCREWED UP!
> ;END OF CONDITIONAL ON FILCAP
;ROUTINE TO LOOK UP AN INTRINSIC FUNCTION
;CALLING SEQUENCE:
; PUSHJ PDP,INTCHK
; FOUND RETURN
; NO FOUND RETURN
;ON ENTRY AC 'SYMBOL' CONTAINS THE SIXBIT NAME. ON RETURN, AC
;'CNT' REFERENCES THE FUNCTION NAME WITH RESPECT TO FUNTAB
INTCHK: MOVSI CNT,FUNLEN ;NEG NUMBER OF FUNCTIONS
CAMN SYMBOL,FUNTAB(CNT) ;IS THIS THE ONE?
POPJ PDP, ;YES -- NON SKIP RETURN
ADD CNT,ONETWO ;ADVANCE COUNT
JUMPL CNT,.-3
AOS (PDP) ;NOT FOUND SO SKIP RETURN
POPJ PDP,
;TABLE OF INTRINSIC ABACUS FUNCTIONS
DEFINE FUNCTS (A,B,C)
<SIXBIT /A/
BYTE (6)B(12)0(18)C
>
FUNTAB: FUNCTS (SQRT,1,SQRT)
FUNCTS (LOG,1,LOG)
FUNCTS (EXP,1,EXP)
FUNCTS (SIN,1,SIN)
FUNCTS (COS,1,COS)
FUNCTS (SIND,1,SIND)
FUNCTS (COSD,1,COSD)
FUNCTS (TAN,1,TAN)
FUNCTS (TAND,1,TAND)
FUNCTS (COT,1,COT)
FUNCTS (COTD,1,COTD)
FUNCTS (ATAN,1,ATAN)
FUNCTS (ATAND,1,ATAND)
FUNCTS (ABS,1,ABS)
FUNCTS (INT,1,INT)
FUNCTS (MOD,2,MOD)
FUNCTS (FACT,1,FACT)
FUNLEN=FUNTAB-.
;ROUTINE TO PRINT A VARIABLE ASSIGNMENT
;CALL PUSHJ PDP,PRTVAR
;ON ENTRY, "B" SHOULD INDEX LABTAB
PRTVAR: MOVE SYMBOL,LABTAB(B)
MOVE N,LABTAB+1(B)
SPEAK [ASCIZ / %S=%F%_/]
POPJ PDP,
;ROUTINE TO HANDLE THE FOLLOWING PROCESSOR TRAPS
; 1)PDL OVERFLOW (BIT 19 -- 200000)
; 2)ARITH. OVER/UNDERFLOW (BIT 32 -- 10)
;AT STARTUP, .JBAPR POINTS TO TRAPIT AND THE APRENB CALL IS ISSUED
;TRAPIT SET THE FLAGS F.OVER AND F.UNDR APPROPRIATELY
;AND IF THE TRAP IS IN AN OPERATION ROUTINE, PRINTS A MESSAGE
;AND SUPPLIES AC 'N' WITH AN OVER OR UNDERFLOW VALUE, THEN CONTINUES
;PDL OVERFLOWS ARE ANALYZED AND A MESSSAGE PRINTED WITH CONTROL
;BEING TRANSFERRED TO THE TOP LEVEL
TRAPIT: TRZ FLAGS,F.OVER+F.UNDR ;CLEAR OVER/UNDERFLOW FLAGS
PUSH PDP,A ;SAVE AC 'A'
MOVE A,.JBTPC ;GET PC FLAGS
TLNE A,(1B11) ;UNDERFLOW?
JRST TRAP1
TLNE A,(1B12) ;ZERO DIVIDE?
JRST TRAP3
TLNE A,(1B3) ;OVERFLOW?
JRST TRAP2
JUMPL STACK,.+2 ;STACK OVERFLOW?
ERR STKOVF
JUMPLE PDP,TRAP4 ;REGULAR PDL OVERFLOW?
HRRZ N,A ;GET ADR. OF TRAP
ERR PDLOVF
TRAP4: POP PDP,A ;RESTORE AC 'A'
JRST @.JBTPC ;CONTINUE PROGRAM
TRAP1: TROA FLAGS,F.UNDR ;SET UNDER
TRAP2: TRO FLAGS,F.OVER ;OR OVERFLOW FLAGS
HRRZ A,.JBTPC ;GET TRAP LOCATION
CAIL A,BCALC ;IS IT IN A USER OPERATION?
CAIL A,ECALC
JRST TRAP4 ;NO, SO WE'RE DONE HERE
TRNN FLAGS,F.OVER ;OVERFLOW?
JRST TRAP2B ;NO, SO MUST BE UNDERFLOW
JUMPL N,TRAP2A ;WHAT KIND OF OVERFLOW?
SPEAK POSOVF
HRLOI N,377777 ;LARGEST POS. NUMBER
JRST TRAP4
TRAP2A: SPEAK NEGOVF
MOVE N,MIFI ;LARGEST NEG. NUMBER
JRST TRAP4
TRAP2B: SPEAK UNDFLO
SETZ N, ;ZERO N
JRST TRAP4
TRAP3: TRO FLAGS,F.OVER
SPEAK DIVZER
JRST TRAP4
;UUO HANDLING ROUTINE
;CALLS ARE AS FOLLOWS:
; SPEAK [ASCIZ /TEXT/]
; ERR [ASCIZ /TEXT/]
; ERRF [ASCIZ /TEXT/]
; ALL OUTPUT THE MESSAGE BUT SPEAK RETURNS TO THE FOLLOWING LOCATION
; WHILE ERR REINITIALIZES THE PDL AN RETURNS TO BEGIN AND ERRF
; CLOSES FILES BEFORE RETURNING TO BEGIN
;IF THE CHARACTER "%" IS FOUND IN THE TEXT, THEN A SPECIAL CHARACTER
;IS ASSUMED TO BE NEXT. THESE SPECIAL CHARACTERS CAUSE THE EXECUATION
;OF THE FOLLOWING OPERATIONS:
; 1) "_" MEANS PRINT A <CR>
; 2) "O" MEANS PRINT THE OCTAL VALUE IN AC 'N'
; 3) "D" MEANS PRINT THE DECIMAL INTEGER IN AC 'N'
; 4) "F" MEANS PRINT THE FLOATING POINT VALUE IN AC 'N'
; 5) "S" MEANS PRINT THE SIXBIT WORD IN AC 'SYMBOL'
; 6) "P" MEANS PRINT THE SIXBIT DEVICE IN OPENBK+1
; 7) "B" MEANS PRINT THE FILE SPECIFICATION FROM FILDAT
; 8) ANY OTHERS ARE PRINTED AS THEY ARE
UUOH: PUSH PDP,A
PUSH PDP,B
PUSH PDP,C
PUSH PDP,D
LDB A,[POINT 9,.JBUUO,OPFLD]
CAIG A,3
JRST .+1(A)
ERR BADUUO
JRST SPEAKR
JRST ERROR
JRST ERRORF
SPEAKR: PUSHJ PDP,TALKER
POP PDP,D
POP PDP,C
POP PDP,B
POP PDP,A
POPJ PDP,
ERRORF: IFN FILCAP,<
CLOSE CHANI,0
RELEASE CHANI,
CLOSE CHANO,40
RELEASE CHANO,
PUSHJ PDP,MBACK
> ;END OF COND. ON FILCAP
ERROR: TRZ FLAGS,F.FCHR ;SWITCH BACK TO TTY
PUSHJ PDP,TALKER
PUSHJ PDP,CRLF2
TRZE FLAGS,F.DEFN
SOS FUNNXT
MOVE PDP,PDLPNT
PUSHJ PDP,THRUST ;READ THROUGH STATEMENT
JRST BEGIN
TALKER: MOVSI D,(POINT 7,0)
HRR D,.JBUUO
JRST TALK2 ;SKIP OVER PRINT FIRST TIME
TALK1: PUSHJ PDP,OUTCHR ;PRINT THE CHARACTER
TALK2: ILDB C,D
JUMPE C,CPOPJ ;DONE?
CAIE C,"%" ;SPECIAL CHARACTER FOLLOWS?
JRST TALK1 ;NO, SO PUT IT OUT
;YES, GET AND ANALYZE THE NEXT
ILDB C,D
JUMPE C,CPOPJ
CAIN C,"_" ;PRINT <CR?
JRST PUTCR
CAIN C,"O" ;PRINT OCTAL NUMBER?
JRST PRTOCT
CAIN C,"D" ;PRINT DECIMAL INTEGER?
JRST PRTDEC
CAIN C,"F" ;PRINT FLOATING POINT NUMBER?
JRST PRTFLT
CAIN C,"S" ;PRINT SIXBIT WORD?
JRST PUTSIX
CAIN C,"P" ;PRINT DEVICE NAME?
JRST PRTDEV
CAIE C,"B" ;PRINT FILE SPECIFICATION?
JRST TALK1
IFE FILCAP,<ERR NOFCAP>
IFN FILCAP,<
PRTFL: PUSHJ PDP,FILTYP
JRST TALK1
>
PUTSIX: PUSHJ PDP,SIXOUT
JRST TALK2
PUTCR: PUSHJ PDP,CRLF
JRST TALK2
PRTOCT: PUSHJ PDP,OCTPNT
JRST TALK2
PRTDEC: PUSHJ PDP,DECPNT
JRST TALK2
PRTFLT: PUSHJ PDP,FLOCON
JRST TALK2
PRTDEV: IFN FILCAP,<
MOVE SYMBOL,OPENBK+1
PUSHJ PDP,SIXOUT
>
JRST TALK1
;ROUTINE TO SKIP OVER THE REMAINDER OF A TTY INPUT LINE
;CALL PUSHJ PDP,THRUST
THRUST: TLNE CHR,C.TERM
POPJ PDP,
PUSHJ PDP,CHRIN
JRST THRUST
SUBTTL MATHEMATICAL ROUTINES ADAPTED FROM BASIC V17
;FLOATING POINT SINGLE PRECISION EXPONENTIAL FUNCTION
;THE ARGUMENT IS RESTRICTED TO THE FOLLOWING RANGE
; -88.028<X<88.028
;IF X<-88.028, THE PROGRAM RETURNS ZERO AS THE ANSWER
;IF X>88.028, THE PROGRAM RETURNS +INFINITY AS THE ANSWER
;THE RANGE OF THE ARGUMENT IS REDUCED AS FOLLOWS:
;EXP(X) = 2**(X*LOG(B)BASE2) = 2**(M+F)
;WHERE M IS AN INTEGER AND F IS N FRACTION
;2**M IS CALLCULATED BY ALGEBRAICALLY ADDING M TO THE EXPONENT
;OF THE RESULT OF 2**F, 2**F IS CALCULATED AS
;2**F = 2(0.5+F(A+B*F^2) - F -C(F^2 + D)**-1)**-1
;THE ROUTINE HAS THE FOLLOWING CALLING SEQUENCE:
; PUSHJ PDP,EXP
;THE ARGUMENT IS IN N--ANSWER RETURNED IN N
EXP: MOVEI SYMBOL,1
PUSHJ PDP,PCALL1
MOVE N,(A)
PUSHJ PDP,EXPB
PUSH STACK,N
JRST FRET
EXPB: MOVE A,N
MOVM N,A ;GET ABS. VAL.
CAMLE N,E7 ;IS ARGUMENT IN RANGE?
JRST EXTOLG ;EXPONENT TOO LARGE
EXP1: SETZM ES2
MULI A,400 ;SEPARAGE FRACTION AND EXPONENT
TSC A,A ;GET N POSITIVE EXPONENT
MUL B,E5 ;FIXED POINT MULTIPLY BY LOG2(B)
ASHC B,-242(A) ;SEPARATE FRACTION AND INTEGER
AOSG B ;ALGORITHM CALLS FOR MULT BY 2
AOS B ;ADJUST IF FRACTION WAS NEG.
HRRM B,EX1 ;SAVE FOR FUTURE SCALE
ASH C,-10 ;MAKE ROOM FOR EXPONENT
TLC C,200000 ;PUT 200 IN EXPONENT BITS
FADB C,ES2 ;NORMALIZE
FMP C,C ;FORM X^2
MOVE N,E2 ;GET 1ST CONSTANT
FMP N,C ;E2*X^2 INTO N
FAD C,E4 ;ADD E4 INTO RESULTS IN B
MOVE A,E3 ;PICK UP E3
FDV A,C ;CALCULATE E3/(F^2 +E4)
FSB N,A ;E2*F^2-E3(F^2+E4)**-1
MOVE B,ES2 ;GET F AGAIN
FSB N,B ;SUBTRACT FROM PARTIAL SUM
FAD N,E1 ;ADD IN E1
FDVM B,N ;DIVIDE BY F
FAD N,E6 ;ADD 0.5
XCT EX1 ;EXECUTE SCALE OF RESULTS
POPJ PDP, ;DONE
;CONSTANTS USED IN ROUTINE ABOVE
E1: 204476430062 ;9.95459578
E2: 174433723400 ;0.03465735903
E3: 212464770715 ;617.97226953
E4: 207535527022 ;87.417497202
E5: 270524354513 ;LOG(B), BASE 2
E6: 0.5
E7: 207540071260 ;88.028
EXTOLG: JUMPG A,EXTOL1
SPEAK UNDEXP
SETZ N, ;GIVE A ZERO VALUE
POPJ PDP, ;RETURN
EXTOL1: SPEAK OVREXP
HRLOI N,377777 ;GIVE LARGEST VALUE
POPJ PDP, ;RETURN
;FLOATING POINT SINGLE PRECISION LOGARITHM FUNCTION
;LOG(ABSF(X)) IS CALCULATED BY THE SUBROUTINE, AND AN
;ARGUMENT OF ZERO IS RETURNED AS MINUS INFINITY. THE ALGORITHM IS
;LOG2(F) = C1*Z + C3*Z^3 + C5*Z^5 -1/2
;AND Z = (F-SQRT(2))/(F+SQRT(2))
;THE CALLING SEQUENCE IS:
; PUSHJ PDP,LOGB
;THE ARGUMENT IS IN N, RESULT IS RETURNED IN N
LOG: MOVEI SYMBOL,1 ;ONE ARGUMENT
PUSHJ PDP,PCALL1 ;GET IT'S ADR.
MOVE N,(A) ;AND MOVE IT INTO N
PUSHJ PDP,LOGB ;EVALUATE FUNCTION
PUSH STACK,N ;PUSH RESULT ON STACK
JRST FRET ;FUNCTION RETURN
LOGB: JUMPL N,ALOGB1 ;TEST FOR LOG OF NEG NBER
ALOGB2: MOVMS N ;GET ABSF(X)
JUMPE N,LZERO ;CHECK FOR ZERO ARG
CAMN N,ONE ;CHECK FOR 1.0 ARG
JRST ZERANS ;IF SO RETURN ZERO
ASHC N,-33 ;SEPARATE FRACTION FROM EXPONENT
ADDI N,211000 ;FLOAT THE EXPONENT AND MULT. BY 2
MOVSM N,C3 ;NUMBER NO IN CORRECT FL. FORM
MOVSI N,567377 ;SET UP -401.0 FROM EXP.*2
FADM N,C3 ;SUBTRACT 401 FROM EXP.*2
ASH N1,-10 ;SHIFT FRACTION FOR FLOATING
TLC N1,200000 ;FLOAT THE FRACTIONAL PART
FAD N1,L1 ;B = T-SQRT(2.0)/2.0
MOVE N,N1 ;PUT RESULTS IN N
FAD N,L2 ;A = N+SQRT(2.0)
FDV N1,N ;B =B/A
MOVEM N1,LZ ;STORE NEW VARIABLE IN LZ
FMP N1,N1 ;CALCULATE Z^2
MOVE N,L3 ;PICK UP FIRST CONSTANT
FMP N,N1 ;MULTIPLY BY Z^2
FAD N,L4 ;ADD IN NEXT CONSTANT
FMP N,N1 ;AND MULTIPLY BY Z^2
FAD N,L5 ;ADD IN NEXT CONSTANT
FMP N,LZ ;MULTIPLY BY Z
FAD N,C3 ;ADD IN EXPONENT TO FORM LOG2(X)
FMP N,L7 ;MULTIPLY TO FORM LOGE(X)
POPJ PDP, ;RETURN
LZERO: SPEAK LOGZER
MOVE N,MIFI ;PICK UP MINUS INFINITY
POPJ PDP,
ZERANS: SETZI N, ;MAKE ARG ZERO
POPJ PDP,
;CONSTANTS FOR ALOGB
ONE: 201400000000
L1: 577225754146 ;-0.707106781187
L2: 201552023632 ;1.414213562374
L3: 200462532521 ;0.5989786496
L4: 200754213604 ;0.9614706323
L5: 202561251002 ;2.8853912903
ALOGB1: SPEAK LOGNEG
JRST ALOGB2 ;USE ABS. VAL.
L7: 200542710300 ;0.69314718056
MIFI: XWD 400000,000001 ;LARGEST NEGATIVE NBER
;SINGLE PRECISION EXP.2 FUNCTION
;THIS ROUTINE CALCULATES A FLOATING POINT NBER TO A FIXED POINT
;POWER. THE CALCULATION IS A**B WHRE T IS OF THE FORM
; T=Q(1)*2 + Q(2)*4 + . . . WHERE Q(I)=0 OR 1
;THE BASE IS IN ACCUMULATOR N
;AND THE EXPONENT IS IN ACCUMULATOR N1 WHEN THE ROUTINE IS CALLED
;THE ANSWER IS RETURNED IN ACCUMULATOR N.
;EXP.2 IS CALLED ONLY BY EXP.3 IT IS GUARANTEED THAT THE BASE AND
;THE EXPONENT ARE NON-ZERO.
EXP2.0: PUSH PDP,N1 ;SAVE FOR OVER/UNDERFLOW CHECK
PUSH PDP,N
MOVSI A,(1.0)
JUMPGE N1,FEXP2
MOVMS N1
FDVRM A,N
MOVSI A,(1.0)
JRST FEXP2
FEXP1: FMP N,N ;FORM A**N IN FLOATING POINT
LSH N1,-1 ;SHIFT EXPONENT FOR NEXT BIT
FEXP2: TRZE N1,1 ;IS THE BIT ON?
FMP A,N ;YES, MULTIPLY ANSWER BY A**N
JUMPN N1,FEXP1 ;UPDATE A**N UNLESS ALL DONE
MOVE N,A ;PICK UP RESULT FROM A
TRNE FLAGS,F.OVER+F.UNDR ;OVER OR UNDERFLOW?
JRST FEXP4
POP PDP,N1 ;CLEAR UP PDL
POP PDP,N1
POPJ PDP,
FEXP4: POP PDP,N ;OVER/UNDERFLOW ROUTINE
POP PDP,N1
MOVM A,N
CAMG A,ONE
JRST .+3 ;BASE >1, EXP>0 MEANS OVER
JUMPG N1,.+3 ;BASE >1, EXP<0 MEANS UNDER
JRST EXP3D3 ;BASE <1, EXP>0 MEANS OVER
JUMPG N1,EXP3D3 ;BASE <1, EXP<0 MEANS OVER
JUMPG N,.+3 ;THIS IS OVER, CHECK SIGN
TRNE N1,1
JRST FEXP5
PUSHJ PDP,EXP3D2
HRLOI N,377777
POPJ PDP,
FEXP5: PUSHJ PDP,EXP3D2
MOVE N,MIFI ;RETURN - INFINITY
POPJ PDP,
;SINGLE PRECISION FORTRAN IV EXP.3 FUNCTION
;THIS ROUTINE CALCULATES A FLOATING POINT NUMBER RAISED TO A
;FLOATING POINT POWER. THE CALCULATION IS
; A**B = EXP(B*LOG(N))
;IF THE EXPONENT IS AN INTEGER THE RESULT WILL BE COMPUTED BY EXP2.0
;THE CALLING SEQUENCE FOR THE ROUTINE IS AS FOLLOWS:
; PUSHJ PDP,EXP3.0
;THE BASE IS IN ACCUMULATOR N
;AND THE EXPONENT IS IN ACCUMULATOR N1 WHEN THE ROUTINE IS CALLED.
;THE RESULT IS RETURNED IN ACCUMULATOR N.
EXP3.0: JUMPE N1,EXP3A ;ZERO EXPONENT?
JUMPN N,EXP3A0 ;ZERO BASE?
JUMPL N1,EXPB3 ;ERROR IF BASE=0 AND EXP<0
POPJ PDP, ;IMMEDIATE RETURN IF BASE=0, EXP>=0
EXP3A0: MOVM B,N1 ;SET UP ABS. VAL. OF EXPON FOR SHIFT
JUMPL N,EXP3C ;IS BASE NEGATIVE?
EXP3A1: MOVEI A,0 ;CLEAR A
LSHC A,11 ;SHIFT 9 BITS TO LEFT
SUBI A,200 ;TO OBTAIN SHIFT FACTOR
JUMPLE A,EXP3GO ;IS A > 0?
HRRZ C,A ;SET UP C AS INDEX REG.
CAILE C,43
JRST EXP3GO
MOVEI A,0
LSHC A,(C) ;SHIFT LEFT BY CONTINTS OF C
JUMPN B,EXP3GO ;IS EXPONENT AN INTEGER?
SKIPGE N1 ;YES, WAS IT NEGATIVE?
MOVNS A ;YES , NEGATE IT
MOVE N1,A ;MOVE INTEGER INTO N1
JRST EXP2.0 ;OBTAIN RESULT USING EXP2.0
EXP3GO: PUSH PDP,N1 ;SAVE EXPONENT
PUSHJ PDP,LOGB ;CALCULATE LOG OF N
FMPR N,(PDP) ;CALCULATE B*LOG(N)
POP PDP,N1 ;RESTORE EXPONENT
TRNE FLAGS,F.UNDR+F.OVER
JRST EXP3D
MOVM N1,N
CAMLE N1,E7
JRST EXP3D1
PUSHJ PDP,EXPB ;CALCULATE EXP(B*LOG(N))
POPJ PDP, ;RETURN
EXP3D: MOVM N1,N
CAML N1,ONE ;LESS THAN 1.0?
JRST EXP3A ;UNDERFLOW MEANS ANSWER=1
EXP3D1: JUMPL N,EXP3D3 ;OVERFLOW MEANS OVER/UNDER IN ANS.
EXP3D2: SPEAK OVRUPO
HRLOI N,377777 ;RETURN LARGEST VALUE
POPJ PDP,
EXP3D3: SPEAK UNDUPO
SETZ N,
POPJ PDP,
EXP3A: MOVSI N,(1.0) ;ANSWER IS 1.0
POPJ PDP,
EXPB3: SPEAK NEGPOW
HRLOI N,377777
POPJ PDP,
EXP3C: MOVE D,B
FAD D,FIXCON
FSB D,FIXCON
CAMN B,D
JRST EXP3A1 ;NEGATIVE BASE, INTEGRAL POWER
SPEAK ABSPOW
EXP3C0: MOVMS N
JRST EXP3A0
;FLOATING POINT SINGLE PRECISION SQUARE ROOT FUNCTION
;THE SQUARE ROOT OF THE ABSOLUTE VALUE OF THE ARGUMENT IS CALCULATED.
;THE ARGUMENT IS WRITTEN IN THE FORM
; X= F*(2**2B) WHERE 0<F<1
;SQRT(X) IS THEN CALCULATED AS (SQRT(X))*(2**B)
;SQRT(F) IS CALCULATED BY N LINEAR APPROXIMATION, THE NATURE
;OF WHICH DEPENDS ON WHETHER 1/4 <F < 1/2 OR 1/2 < F < 1.
;FOLLOWED BY TWO ITERATIONS OF NEWTON'S METHOD.
;THE CALLING SEQUENCE IS
; PUSHJ PDP,SQRTB
;THE ARGUMENT IS IN N ON ENTRY, THE RESULT IS RETURNED IN N.
SQRT: MOVEI SYMBOL,1
PUSHJ PDP,PCALL1
MOVE N,(A)
PUSHJ PDP,SQRTB
PUSH STACK,N
JRST FRET
SQRTB: MOVE A,N ;PICK UP THE ARGUMENT IN N1
JUMPL A,SQRMIN ;SQRT OF NEG. NBER?
JUMPE A,SQRT1 ;ARGUMENT OF ZERO?
SQRTB0: ASHC A,-33 ;PUT EXPONENT IN A,FRACTION IN B
SUBI A,201 ;SUBTRACT 201 FROM EXPONENT
ROT A,-1 ;CUT EXP IN HALF, SAVE ODD BIT
HRRM A,EX1 ;SAVE FOR FUTURE SCALING OF ANS
;IN FSC N,. INSTRUCTION
LSH A,-43 ;GET BIT SAVE ABOVE
ASH B,-10 ;PUT FRACTION IN PROPER POSITION
FSC B,177(A) ;PUT EXPONENT OF FRACT TO -1 OR 0
MOVEM B,N ;SAVE IT. 1/4 < F < 1
FMP B,SQCON1(A) ;LINEAR 1ST APPROX. DEPENDS ON
FAD B,SQCON2(A) ;WHETHER 1/4 < F <1/2 OR 1/2<F<1
MOVE A,N ;START NEWTON'S METHOD WITH FRAC
FDV A,B ;CALCULATE X(0)/X(1)
FAD B,A ;X(1)+X(0)/X(1)
FSC B,-1 ;1/2(X(1)+X(0)/X(1))
FDV N,B ;X(0)/X(2)
FADR N,B ;X(2)+X(0)/X(2)
XCT EX1 ;SCALE
SQRT1: POPJ PDP, ;RETURN
SQCON1: 0.8125 ;CONSTANT IF 1/4<FRAC<1/2
0.578125 ;CONSTANT IF 1/2<FRAC<1
SQCON2: 0.302734 ;CONSTANT IF 1/4<FRAC<1/2
0.421875 ;CONSTANT IF 1/2<FRAC<1
SQRMIN: PUSH PDP,A ;SAVE A
SPEAK SQTNEG
POP PDP,A
MOVMS A
JRST SQRTB0
;FLOATING POINT SINGLE PRECISION SINE AND COSINE FUNCTION
;THE ARGUMENT IS IN RADIANS
;ENTRY POINTS ARE SINB AND COSB
;COSB CALLS SINB TO CALCULATE SINB(PI/2+X)
;THE ROUTINE CALCULATES SINES AFTER REDUCING THE ARGUMENT TO THE
;FIRST QUADRANT AND CHECKING THE OVERFLOW BITS TO DETERMINE
;THE QUADRANT OF THE ORIGINAL ARGUMENT
;000 - 1ST QUADRANT
;001 - 2ND QUADRANT, X=-(X-PI)
;010 - 3RD QUADRANT, X=-(X-PI)
;011 - 4TH QUADRANT, X=X-3*PI/2-PI/2
;THE ALGORITHM USES N MODIFIED TAYLOR SERIES TO CALCULATE
;THE SINE OF THE NORMALIZED ARGUMENT.
COSD: TRO FLAGS,F.DEG ;DEGREES RATHER THAN RADIANS
COS: MOVEI SYMBOL,1 ;ONE ARG
PUSHJ PDP,PCALL1
MOVE N,(A)
TRZE FLAGS,F.DEG
FDVR N,DEGTRD ;CONVERT DEG. TO RAD.
PUSHJ PDP,COSB
PUSH STACK,N
JRST FRET
SIND: TRO FLAGS,F.DEG ;WANT DEGREES NOT RADIANS
SIN: MOVEI SYMBOL,1
PUSHJ PDP,PCALL1
MOVE N,(A)
TRZE FLAGS,F.DEG ;CONVERT DEG. TO RAD.?
FDVR N,DEGTRD ;CONVERT
PUSHJ PDP,SINB
PUSH STACK,N
JRST FRET
COSB: ;ENTRY TO COSINE IN RADIANS
FADR N,PIOT ;ADD PI/2
;FALL INTO SINE ROUTINE
SINB: ;ENTRY INTO SINE IN RADIANS
MOVE A,N ;PICK UP ARGUMENT IN A
MOVEM A,SX ;SAVE IT
MOVMS A ;GET ABS. VAL.
CAMG A,SP2 ;SINX = X IF X<2^-10
POPJ PDP, ;EXIT WITH ANS=ARGUMENT
FDV A,PIOT ;DIVIDE X BY PI/2
CAMG A,ONE ;IS X/(PI/2) <1.0?
JRST S2 ;YES, ARG IN 1ST QUADRANT
MULI A,400 ;NO, SEPARATE FRACTION AND EXP.
ASH B,-202(A) ;GET X MODULO 2PI
MOVEI A,200 ;PREPARE FLOATING FRACTION
ROT B,3 ;SAVE 3 BITS TO FIND QUADRANT
LSHC A,33 ;ARGUMENT NOW IN RANGE (-1,1)
FAD A,SP3 ;NORMALIZE THE ARGUMENT
JUMPE B,S2 ;REDUCED TO FIRST QUAD IF BITS 00
TLCE B,1000 ;SUBRACT 1.0 FROM ARG IF BITS ARE
FSB A,ONE ;01 OR 11
TLCE B,3000 ;CHECKR FOR FIRST QUADRANT, 01
TLNN B,3000 ;CHECK FOR 3RD QUADRANT, 10
MOVNS A ;01,10
S2: SKIPGE SX ;CHECKR SIGN OF ORIGINAL ARG
MOVNS A ;SIN(-X) = -SIN(X)
MOVEM A,SX ;STORE REDUCED ARGUMENT
FMPR A,A ;CALCULATE X^2
MOVE N,SC9 ;GET 1ST CONSTANT
FMP N,A ;MULTIPLY BY X^2
FAD N,SC7 ;ADD IN NEXT CONSTANT
FMP N,A ;MULTIPLY BY X^2
FAD N,SC5 ;ADD IN NEXT CONSTANT
FMP N,A ;MULTIPLY BY X^2
FAD N,SC3 ;ADD IN NEXT CONSTANT
FMP N,A ;MULTIPLY BY X^2
FAD N,PIOT ;ADD IN LAST CONSTANT
S2B: FMPR N,SX ;MULTIPLY BY X
POPJ PDP, ;DONE
SC3: 577265210372 ;-0.64596371106
SC5: 175506321276 ;0.07968967928
SC7: 606315546346 ;0.00467376557
SC9: 164475536722 ;0.00015148419
PIOT: 201622077325 ;PI/2
DEGTRD: 57.2957795 ;CONVERSION FOR DEGREES TO RADIANS
SP2: 170000000000 ;2**-10
SP3: 0 ;0
CD1: 90.0
SCD1: 206712273406 ;
;TANGENT/COTANGENT FUNCTION USING SIN AND COS
;SHALL WE GET N REAL TAN ROUTINE?
;TANGENT(X)=SIN(X)/COS(X)
;COTAN(X)=TAN(PI/2-X)
TAND: TRO FLAGS,F.DEG
TAN: MOVEI SYMBOL,1
PUSHJ PDP,PCALL1
MOVE N,(A)
TRZE FLAGS,F.DEG
FDVR N,DEGTRD
PUSHJ PDP,TANB
PUSH STACK,N
JRST FRET
COTD: TRO FLAGS,F.DEG
COT: MOVEI SYMBOL,1
PUSHJ PDP,PCALL1
MOVE N,(A)
TRZE FLAGS,F.DEG
FDVR N,DEGTRD
PUSHJ PDP,COTB
PUSH STACK,N
JRST FRET
COTB: MOVNS N ;CALCULATE -X
FADR N,PIOT ;ADD IN PI/2
TANB: MOVEM N,C3 ;SAVE IT
PUSHJ PDP,COSB ;CALCULATE COSINE
JUMPE N,TANB1 ;IS COS=0?
EXCH N,C3 ;SAVE COS, GET ARG
PUSHJ PDP,SINB ;CALCULATE SINE
FDVR N,C3 ;CALCULATE SIN/COS
POPJ PDP, ;AND RETURN
TANB1: SPEAK POTTAN
HRLOI N,377777 ;LARGEST NBER_
POPJ PDP,
;FLOATING POINT SINGLE PRECISION ARCTANGENT FUNCTION
;ATAN(X) = X(B0+A1(Z+B1-A2(Z+B3)**-1)**-1)**-1)
;WHERE Z=X^2 IF 0<X<=1
;IF X>1 THEN ATAN(X)=PI/2 - ATAN(1/X)
;IF X>1 THEN RH(A) =-1 AND LH(A)= -SGN(X)
;IF X<1 THEN RH(A) = 0 AND LH(A)= SGN(X)
ATAND: TRO FLAGS,F.DEG ;WANT ANSWER IN DEGREES
ATAN: MOVEI SYMBOL,1
PUSHJ PDP,PCALL1
MOVE N,(A)
PUSHJ PDP,ATANB
TRZE FLAGS,F.DEG
FMPR N,DEGTRD ;CONVERT ANSWER TO DEGREES
PUSH STACK,N
JRST FRET
ATANB: ;ENTRY TO ATAN ROUTINE
MOVM A,N ;GET ABS OF ARG
CAMG A,A1 ;IF A<2^-33 THEN RETURN
POPJ PDP, ;WITH ATAN(X)=X
HLLO C,N ;SAVE SIGN WITH RH=-1
CAML A,A2 ;IF A>2^33 THEN RETURN
JRST AT4 ;WITH ATAN(X)=PI/2
MOVSI B,(1.0)
CAMG A,B ;IS ABS(X)>1.0?
TRZA C,-1 ;IF T<=1.0 THEN RH(C)=0
FDVM B,A ;BB IS REPLACED BY 1.0/B
TLC C,(C) ;XOR SIGN WITH .G. 1.O INDICATOR
MOVEM A,C3 ;SAVE THE ARG
FMP A,A ;GET B^B
MOVE B,KB3 ;PICK UP N CONATANT
FAD B,A ;ADD B^2
MOVE N,KA3 ;ADD IN NEXT CONSTANT
FDVM N,B ;FORM -A3/(B^2+B3)
FAD B,A ;ADD B^2 TO PARTIAL SUM
FAD B,KB2 ;ADD B2 TO PARTIAL SUM
MOVE N,KA2 ;PICK UP -A2
FDVM N,B ;DIVIDE PARTIAL SUM BY -A2
FAD B,A ;ADD B^2 TO PARTIAL SUM
FAD B,KB1 ;ADD B1 TO PARTIAL SUM
MOVE N,KA1 ;PICK UP A1
FDV N,B ;DIVIDE PARTIAL SUM BY A1
FAD N,KB0 ;ADD B0
FMP N,C3 ;MULTIPLY BY ORIGINAL ARG
TRNE C,-1 ;CHECK .G. 1.0 INDICATOR
FSB N,PIOT ;ATAN(N)= -ATAN(1/A)-PI/2)
CAIA ;SKIP
AT4: MOVE N,PIOT ;GET PI/2 AS ANS.
NEGANS: SKIPGE C ;LH(A)=-SGN(A) IF B>1.0
MOVNS N ;NEGATE IT
POPJ PDP, ;RETURN
A1: 145000000000 ;2**-33
A2: 233000000000 ;2**33
KB0: 176545543401 ;0.1746554388
KB1: 203660615617 ;6.762139240
KB2: 202650373270 ;3.316335425
KB3: 201562663021 ;1.448631538
KA1: 202732621643 ;3.709256262
KA2: 574071125540 ;-7.106760045
KA3: 600360700773 ;-0.2647686202
;ROUTINE TO TAKE ABSOLUTE VALUE
ABS: MOVEI SYMBOL,1
PUSHJ PDP,PCALL1
MOVM N,(A)
PUSH STACK,N
JRST FRET
;ROUTINE TO TRUNCATE FRACTIONAL PART OF FLOATING POINT NUMBER
INT: MOVEI SYMBOL,1
PUSHJ PDP,PCALL1
MOVM N,(A)
SKIPGE (A) ;NEGATIVE?
FAD N,ALMST1 ;YES, MAKE INT(-2.3)=-3,ETC.
CAML N,MOD1 ;IS ARG <=2^26?
JRST INT1 ;YES; MUST BE INTEGER ANYWAY
FAD N,MOD1
FSB N,MOD1
INT1: SKIPGE (A)
MOVNS N
PUSH STACK,N
JRST FRET
MOD1: XWD 233400,000000 ;2^26
ALMST1: XWD 200777,777777 ;1.0-<SMALEST QUANTITY>
;FLOATING POINT SINGLE PRECISION MOD FUNCTION
;MODF(A,B)=A-[A/B]*B WHERE [A/B] IS THE GREATEST INTEGER
;IN THE MAGNITUDE OF A/B. THE TERM A/B MUST BE LESS THAN
;2^26 IN MAGNITUDE.
MOD: MOVEI SYMBOL,2 ;GET FIRST ARG
PUSHJ PDP,PCALL1
MOVE N,(A)
MOVEI SYMBOL,1 ;GET SECOND ARG
PUSHJ PDP,PCALL1
MOVE N1,(A)
MOVM A,N1 ;GET ABS OF SECOD ARG
FDVM N,N1 ;CALCULATE A/B
TRNE FLAGS,F.OVER+F.UNDR ;OVER OR UNDERFLOW?
JRST DETRMN
MOVMS N1 ;CALCULATE ABS(A/B)
CAML N1,MOD1 ;IF A/B .GT. 2^26
JRST TOOLRG
FAD N1,MOD1 ;TAKE INTEGER PART
FSB N1,MOD1
FMP A,N1 ;C=B*ABS([A/B])
SKIPGE N ;RESTORE THE SIGN
MOVNS A
FSB N,A ;CALCULATE N-[A/B]*N1
OUT: PUSH STACK,N ;PUSH RESULT ONTO STACK
JRST FRET ;RETURN
DETRMN: TRNE FLAGS,F.OVER ;OVERFLOW?
JRST OUT ;NO, UNDERFLOW
TOOLRG: SETZ N,
JRST OUT
;ROUTINE TO RETURN N! WHERE N IS INTEGER 0<=N<=33
FACT: MOVEI SYMBOL,1
PUSHJ PDP,PCALL1
MOVM N1,(A)
SKIPGE (A)
SPEAK NEGFCT
MOVE N,N1 ;TEST IF FRACTION
FAD N1,MOD1 ;MAKE N1 INTEGER
FSB N1,MOD1
CAME N,N1
SPEAK FRCFCT ;NOT AN INTEGER -- TELL THEM SO
CAMLE N1,FCT33 ;WILL OVERFLOW IF N1>33
JRST FACT1A
MOVE N,ONE ;0!=1.0
FACT1: JUMPE N1,FACT2 ;DONE?
FMP N,N1
FSB N1,ONE
JRST FACT1
FACT1A: SPEAK FCTOVR
HRLOI N,377777 ;RETURN LARGEST NUMBER
FACT2: PUSH STACK,N ;PUSH RESULT ONTO STACK
JRST FRET ;AND DO FUNCTION RETURN
FCT33: 33.0 ;FLOATING POINT 33
SUBTTL ERROR ROUTINES AND OTHER MESSAGES
NOTIMP: ERR [ASCIZ /%S COMMAND NOT YET IMPLEMENTED/]
NOFCAP: ASCIZ /%S COMMAND NOT IMPLEMENTED IN THIS VERSION/
LABLON: PUSHJ PDP,LABLN
ERR
LABLN: SPEAK TOOMNY
PUSHJ PDP,SIXOUT
JUMPE CNT,.+5
MOVEI CNT,6
PUSHJ PDP,LABIN
JRST .-4
PUSHJ PDP,SIXOUT
POPJ PDP,
;ERROR ROUTINES FOR FILE CAHANDLING OPTIONS
IFN FILCAP,<
;ROUTINE TO PRINT LOOKUP OR ENTER ERROR CODE MESSAGES
;CALL PUSHJ PDP,FILERR
INPERR: ASCIZ /INPUT ERROR -- CANNOT RECOVER/
OUTERR: ASCIZ /OUTPUT ERROR -- CANNOT RECOVER/
BADEOF: ASCIZ /BAD END TO INPUT FILE %B/
FILERR: HRRZ A,FILNAM+1 ;GET ERROR CODE
CAILE A,2 ;ONLY 3 DIFFERENT MESSAGES
MOVEI A,3 ;UNDEFINED ERROR MESSAGE
SPEAK @FILMSG(A) ;OUTPUT THE MESSAGE
POPJ PDP, ;AND RETURN
FILMSG: NOTFND ;CODE 0 -- FILE NOT FOUND
INCPPN ;CODE 1 -- INCORRECT PPN
PROTFA ;CODE 2 -- PROTECTION FAILURE
UNDEFE ;CODE .GT.2 -- UNDEFINED ERROR
NOIFIL: PUSHJ PDP,FILERR ;PUT OUT ERROR CODE MESSAGE
ERRF NOIFLM
NOIFLM: ASCIZ /INPUT FILE %B/
NOOFIL: PUSHJ PDP,FILERR
ERRF NOOFLM
NOOFLM: ASCIZ /OUTPUT FILE %B/
BADANS: ASCIZ /PLEASE TYPE 'YES' OR 'NO'-- /
BADHLP: ASCIZ %ONLY /L MAY FOLLOW THE HELP COMMAND%
BADHP1: ASCIZ /HELP COMMAND MUST OUTPUT TO TTY OR LPT ONLY/
DELERR: MOVE B,FILBLT ;GET FILE NAME
BLT B,FILNAM+3
ERRF .+1
ASCIZ /CAN'T DELETE THE FILE %B/
RENERR: MOVE B,ABSTMP ;GET TMP FILE NAME
MOVEM B,FILNAM
MOVSI B,(SIXBIT /TMP/)
MOVEM B,FILNAM+1
ERRF .+1
ASCIZ /CAN'T RENAME THE TEMPORARY FILE %B/
LNGDEV: ASCIZ /DEVICE OR FILENAME OF MORE THAN 6 CHARACTERS/
NODEV: ASCIZ /NO DEVICE PRECEEDS COLON/
LNGFIL: ASCIZ /FILENAME OF MORE THAN 6 CHARACTERS/
NOFILE: ASCIZ /NO FILENAME PRECEEDS PERIOD/
LNGEXT: ASCIZ /EXTENSION OF MORE THAN 3 CHARACTERS/
NONOCT: ASCIZ /NON OCTAL DIGIT SEEN/
LNGPRO: ASCIZ /PROTECTION CODE IS A 3 DIGIT OCTAL NUMBER/
NOGTR: ASCIZ /PROTECTION CODE MUST END WITH A GREATER THAN SIGN/
PPNLON: ASCIZ /BAD OCTAL NUMBER %O -- MUST RANGE FROM 1 TO 377777/
ILLPRJ: ASCIZ /BAD DELIMITER FOR PROJECT NUMBER %O -- MUST BE COMMA/
ILLPRG: ASCIZ /BAD END FOR PROGRAMMER NUMBER %O -- MUST BE "]"/
NOTDEV: ASCIZ /NON-EXISTANT DEVICE %P/
BADMOD: ASCIZ /BINARY MODE IS ILLEGAL FOR DEVICE %P/
NOTAVL: ASCIZ /DEVICE %P IS UNAVAILABLE AT THE MOMENT/
NOTID: ASCIZ /DEVICE %P CANNOT DO INPUT/
INDER: ASCIZ /CANNOT OPEN INPUT DEVICE %P/
NOTOD: ASCIZ /DEVICE %P CANNOT DO OUTPUT/
OUTDER: ASCIZ /CANNOT OPEN OUTPUT DEVICE %P/
NOTFND: ASCIZ /CAN'T FIND OR ENTER /
INCPPN: ASCIZ /NON-EXISTANT UFD FOR /
PROTFA: ASCIZ /PROTECTION FAILURE OR DTA DIRECTORY FULL FOR /
UNDEFE: ASCIZ !UNDEFINED I/O ERROR CODE FOR !
PARERR: ASCIZ /BAD PARITY FOR DEFINITION %S -- CAN'T RECOVER/
EMPFIL: ASCIZ /FILE %B IS EMPTY/
BADFIL: MOVE B,FILBLT
BLT B,FILNAM+3
ERRF BADFL1
BADFL1: ASCIZ /IMPROPER FORMAT FOR INPUT FILE %B/
NOBUFC: ASCIZ /CAN'T EXPAND CORE TO SET UP A BUFFER AREA/
RECMSG: ASCIZ / %S RECALLED%_/
DEFONE: ASCIZ /DEFINITON %S EXISTS ON THE FILE%_/
OVERLY: ASCIZ /DO YOU WISH TO OVERLAY WHAT'S ON THE FILE? /
STOMSG: ASCIZ / %S STORED%_/
> ;END OF COND. ON FILCAP
HDMSG: ASCIZ /ABACUS -- V/
TOOMNY: ASCIZ /TOO MANY CHARACTERS IN /
NOCOMD: ASCIZ /NO SUCH COMMAND AS %S/
CNGRST: ASCIZ /%S MAY NOT BE UPDATED BY THIS COMMAND/
LABFUL: ASCIZ /NO ROOM FOR VARIABLE %S/
PNSFUL: ASCIZ /NO MORE ROOM IN PNS/
FORLET: ASCIZ /FOR VARIABLE MUST BEGIN WITH A LETTER ONLY/
FOREQ: ASCIZ /EQUAL SIGN MUST FOLLOW FOR VARIABLE/
BADST: ASCIZ /IMPROPER DELIMITER AFTER STARTING VALUE/
ZERINC: ASCIZ /INCREMENT OF ZERO IS ILLEGAL/
ENDLST: ASCIZ /END<START ILLEGAL FOR POSITIVE INCREMENT/
STLEND: ASCIZ /END>START ILLEGAL FOR NEGITIVE INCREMENT/
NODO: ASCIZ /THE WORD "DO" MUST PRECEED THE EXPRESSION/
NOCNG: ASCIZ /NO CHANGES IN VALUES -- INCREMENT TOO SMALL/
BADLVR: ASCIZ /DO LOOP VALUES MUST BE NUMERIC OR VARIABLES/
UNDVAR: ASCIZ /UNDEFINED VARIABLE %S/
BADCHR: ASCIZ /BAD CHARACTER SEEN IN EXPRESSION/
TRAOPP: ASCIZ /TRAILING OPERATOR/
BADFCL: ASCIZ /BAD END TO FUNCTION CALL/
IMPEXP: ASCIZ /IMPROPER EXPRESSION/
ADJVAR: ASCIZ /ADJACENT TERMS/
MISOPP: ASCIZ /MISSING OPERATOR/
NORPAR: ASCIZ /MISSING RIGHT PARENTHESIS/
MISRP: ASCIZ /MISPLACED RIGHT PARENTHESIS/
EXRP: ASCIZ /EXTRA RIGHT PARENTHESIS/
ADJOPP: ASCIZ /ADJACENT OPERATORS/
LEDADJ: ASCIZ /ONLY NEGATION MAY BE A LEADING OR ADJACENT OPERATOR/
INTEQ: ASCIZ /ONLY A SINGLE VARIABLE MAY PRECEED AN EQUAL SIGN/
MISPC1: ASCIZ /MISPLACED COMMA -- CAN'T FOLLOW LEFT PAREN OR OPERATOR/
MISPC2: ASCIZ /MISPLACED COMMA -- NO PRECEEDING FUNCTION CALL/
UNDFUN: ASCIZ /UNDEFINED FUNCTION %S/
INCARG: ASCIZ /%S IS A FUNCTION OF %D ARGUMENTS /
NUMSUP: ASCIZ /%D WERE SUPPLIED/
ILLCHR: ASCIZ /ILLEGAL CHARACTER SEEN ON INPUT/
NOON: ASCIZ /THE WORD 'ON' MUST PRECEED THE FILE SPECIFICATION/
BADAND: ASCIZ /"&" MAY ONLY COME AT END OF LINE/
ONEDOT: ASCIZ /ONLY ONE DECIMAL POINT PER NUMBER PLEASE/
BADE: ASCIZ /A DIGIT MUST PRECEED "E" FOR SCIN. NOTATION/
BADEDG: ASCIZ /NO NUMBER SEEN AFTER "E" IN NUMBER/
NODIGT: ASCIZ /NO DIGIT FOUND AFTER A DECIMAL POINT/
NUMOVR: ASCIZ /OVERFLOW -- CONSTANT TOO LARGE/
NUMUND: ASCIZ /UNDERFLOW -- CONSTANT TOO SMALL/
DISMSG: ASCIZ / CURRENT DISPLAY=%F%_/
SUBMSG: ASCIZ / SUBTOTAL=%F%_/
SUBOVR: ASCIZ /OVERFLOW ON TAKING A SUBTOTAL/
SUBUND: ASCIZ /UNDERFLOW ON TAKING A SUBTOTAL/
TOTMSG: ASCIZ / TOTAL=%F%_/
CLRTMG: ASCIZ / TOTAL CLEARED%_/
CLRSMG: ASCIZ / SUBTOTAL CLEARED%_/
BAKMSG: ASCIZ / BACKED UP%_/
CNGMSG: ASCIZ / SIGN CHANGED/
JOBMSG: ASCIZ /JOB %D%_/
LETOLY: ASCIZ /LABLES MUST BEGIN WITH A LETTER/
BADFLT: ASCIZ /FUNCTION NAMES MUST BEGIN WITH A LETTER/
BADDUM: ASCIZ /DUMMY ARGUMENTS MUST BE ENCLOSED IN PARENTHESES/
BADDLT: ASCIZ /DUMMY FUNCTION ARGUMENTS MUST BEGIN WITH A LETTER/
TOOMAG: ASCIZ /ONLY %D DUMMY ARGUMENTS MAY BE SUPPLIED/
BADARG: ASCIZ /IMPROPER DUMMY ARGUMENT DELIMITER/
BADFEQ: ASCIZ /EQUAL SIGN MUST FOLLOW FUNCTION NAME AND ARGS/
DEFFUN: ASCIZ / %S DEFINED%_/
RENMSG: ASCIZ /TYPE NEW NAME TO RENAME CURRENT FUNCTION OR <CR> TO DELETE--/
BADFNM: ASCIZ /IMPROPER FUNCTION NAME %S%_/
NOCORE: ASCIZ /CAN'T EXPAND CORE TO CREATE MORE FUNCTION SPACE/
BADDL: ASCIZ /ONLY COMMAS AND CARRIAGE RETURNS ARE LEGAL DELIMITERS/
NOTDEF: ASCIZ / %S NOT DEFINED%_/
ISUFUN: ASCIZ /%S IS IN USE AS A USER DEFINED FUNCTION.%_/
ISCOM: ASCIZ /%S IS RESERVED AS A COMMAND.%_/
ISIFUN: ASCIZ /%S IS RESERVED AS AN INTRINSIC FUNCTION.%_/
ISVAR: ASCIZ /%S IS IN USE AS A VARIABLE.%_/
NOCRUN: ASCIZ /CAN'T CRUNCH CORE/
DELMSG: ASCIZ / %S DELETED%_/
DRONLY: ASCIZ /DEVICES MUST BE DSK OR DTA FOR DELETION/
NOFDEL: ASCIZ /MAY NOT DELETE FROM A FILE/
NOVARS: ASCIZ /%_ NO USER DEFINED VARIABLES%_/
NOFUNS: ASCIZ /%_ NO USER DEFINED FUNCTIONS%_/
STMSG: ASCIZ /%_STATUS OF ABACUS AT /
RUNMSG: ASCIZ /RUN TIME-- /
CNTMSG: ASCIZ /ELAPSED TIME--/
RSTMSG: ASCIZ /MAIN REGISTER 'RESLT'=%F%_/
SRTMSG: ASCIZ /TOTAL REGISTER 'TOT'=%F%_%_/
VARTTL: ASCIZ /%_ USER DEFINED VARIABLES:%_%_/
FUNTTL: ASCIZ /%_ USER DEFINED FUNCTIONS:%_%_/
IFN DEBUG,<
CORUS1: ASCIZ / INITIAL FUNCTION LOCATION -- %O%_/
CORUS2: ASCIZ / NEXT FUNCTION LOCATION -- %O%_/
CORUS3: ASCIZ / MAXIMUM FUNCTION LOCATION -- %O%_/
CORUS4: ASCIZ / BLOCKS CORE (LOW SEGMENT) -- %D%_/
> ;END OF COND ON DEBUG
STKOVF: ASCIZ /STACK OVERFLOW -- FUNCTION CALLS ITSELF/
PDLOVF: ASCIZ /PDL OVERFLOW AT LOCATION %O/
POSOVF: ASCIZ /POSITIVE OVERFLOW%_/
NEGOVF: ASCIZ /NEGATIVE OVERFLOW%_/
UNDFLO: ASCIZ /UNDERFLOW%_/
DIVZER: ASCIZ /DIVISION BY ZERO%_/
UNDEXP: ASCIZ /UNDERFLOW IN EXP ROUTINE%_/
OVREXP: ASCIZ /OVERFLOW IN EXP ROUTINE%_/
LOGZER: ASCIZ /LOG OF ZERO%_/
LOGNEG: ASCIZ /LOG OF NEGATIVE NUMBER%_/
OVRUPO: ASCIZ /OVERFLOW IN EXPONENTIAL ROUTINE%_/
UNDUPO: ASCIZ /UNDERFLOW IN "^" OPERATOR%_/
NEGPOW: ASCIZ /ZERO TO A NEGATIVE POWER%_/
ABSPOW: ASCIZ /ABSOLUTE VALUE RAISED TO A POWER%_/
SQTNEG: ASCIZ /SQRT OF NEGATIVE NUMBER%_/
POTTAN: ASCIZ !TAN OF PI/2 OR COTAN OF ZERO%_!
NEGFCT: ASCIZ /FACTORIAL OF NEGETIVE NUMBER%_/
FRCFCT: ASCIZ /FACTORIAL OF FRACTIONAL NUMBER%_/
FCTOVR: ASCIZ /FACTORIAL ARGUMENT MUST BE LESS THAN 33%_/
NOCONT: ASCIZ /?CAN'T CONTINUE%_/
NOLOGO: ASCIZ /CAN'T DO A LOG OUT--TRY IT FROM MONITOR%_/
NOREDR: ASCIZ /CANNOT RETURN TO READER/
BADEQL: ASCIZ /IMPROPERLY PLACED EQUAL SIGN/
TOCMAG: ASCIZ /TOO MANY ARGUMENTS SUPPLIED TO COMMAND/
NOARGS: ASCIZ /NO ARGUMENTS SUPPLIED TO COMMAND/
SINGLE: ASCIZ /%S COMMAND MUST BE FOLLOWED BY <CR> OR ";"/
NOTERM: ASCIZ /IMPROPER TERMINATION OF LINE -- MUST BE <CR> OR ";"/
BADUUO: ASCIZ /UNDEFINED UUO/
LIST
;MISC. CONSTANTS
PDLPNT: IOWD PDLLEN,PDL ;REG. PDL POINTER
STKST: IOWD STKLEN,STK ;STACK PDL POINTER
ONES: EXP -1 ;WORD OF ALL ONES
IFN FILCAP,<
FILBLT: XWD FILDAT,FILNAM ;WORD FOR BLT OF FILE INFO
SYSPRO: XWD 12,16 ;FOR GETTAB ON STANDARD PROTECTION
CRETIM: POINT 11,FILNAM+2,23 ;FILE CREATION TIME BYPE POINTER
CREDAT: POINT 12,FILNAM+2,35 ;FILE CREATION DATE BYTE POINTER
>
GETSYM: POINT 35,WD,34 ;POINTER TO GET NAME
;INPUTED SANS BIT 35
FNBPT1: POINT 12,@FNSTPT,17 ;POINTER TO GET # SOURCE WORDS
ALLFUN: SIXBIT /ALLFUN/ ;ARG MEANING ALL VARIABLES
ALLVAR: SIXBIT /ALLVAR/ ;ARG MEANING ALL VARIABLES
ON: SIXBIT /ON/ ;DELIMITER ARGUMENT
NO: SIXBIT /NO/
YES: SIXBIT /YES/
CUSP: SIXBIT /ABACUS/ ;NAME OF THE PROGRAM
SUBTTL STORAGE AND STUFF LIKE THAT
IFN PURE,<RELOC 0>
LOWBEG: ;FIRST ADR OF LOW SEGMENT
EX1: BLOCK 1 ;INSTRUCTION FOR SCALE EXECUTION
ES2: BLOCK 1 ;TEMP LOCATION FOR EXP ROUTINE
C3: BLOCK 1 ;TEMP LOCATIONS FOR LOG ROUTINE
LZ: BLOCK 1
SX: BLOCK 1 ;TEMP LOCATION FOR SIN ROUTINE
FORVAR: BLOCK 1 ;FOR VARIABLE NAME TO SAVE
DOREG1: BLOCK 1 ;START VALUE OF DO LOOP
DOREG2: BLOCK 1 ;END VALUE OF DO LOOP
DOREG3: BLOCK 1 ;INCREMENT VALUE OF DO LOOP
PDL: BLOCK PDLLEN ;REGULAR PUSH DOWN LIST
STK: BLOCK STKLEN ;STACK PUSH DOWN LIST
INRNTM: BLOCK 1 ;INITIAL RUN TIME
INCNTM: BLOCK 1 ;INITIAL CONNECT TIME
PNS: BLOCK PNSLEN ;POLISH STRING STORAGE
VARNAM: BLOCK 1 ;NAME OF STORAGE VARIABLE
NUMFLG: BLOCK 1 ;FLAG FOR NUMBER I/O
BRESLT: BLOCK 1 ;BACK UP RESULT
BTOT: BLOCK 1 ;BACK UP TOTAL
;****DO NOT SEPARATE THE FOLLOWINGENTRIES****
LABTOT: BLOCK 1 ;TOTAL NUMBER OF ITEMS IN LABLE TABLE
LABTAB: BLOCK 1 ;THE LABLE TABLE ITSELF
RESLT: BLOCK 1 ;RESLT OF CHAIN OPERATIONS
BLOCK 1
TOT: BLOCK 1
BLOCK LTLEN
;***************************************
NARGS: BLOCK 1 ;NUMBER OF ARGS IN FUNCTION BEING DEFINED
DUMARG: BLOCK MAXARG ;DUMMY ARG LIST
FUNNXT: BLOCK 1 ;POINTER TO NEXT FREE FUNCTION SPACE
FUNMAX: BLOCK 1 ;MAXIMUM LOCATION AVAILABLE TO FUNCTIONS
FNSTPT: BLOCK 1 ;PERMANENT FUNCTION POINTER
FUNPNT: BLOCK 1 ;INDIRECT FUNCTION POINTER
IFN FILCAP,<
OPENBK: BLOCK 3 ;I/O OPEN BLOCK
FILDAT: BLOCK 4 ;FILE INFORMATION STORAGE
IBUF: BLOCK 3 ;INPUT BUFFER HEADER
OBUF: BLOCK 3 ;OUTPUT BUFFER HEADER
ABSTMP: BLOCK 1 ;NAME OF TMP FILE
PARWD: BLOCK 1 ;PARITY WORD
OLDFIL: BLOCK 1 ;SAVE OF OLD PROT, CREATION DATE
> ;END OF COND. ON FILCAP
FILNAM: BLOCK 6 ;FILE LOOKUP, ENTER, RUN BLOCK
PNSLOC: BLOCK 1 ;INDIRECT PNS REFERENCE POINTER
LINK: BLOCK 1 ;LINK TO STACK ADRESSES
LOWEND: ;LAST ADR OF LOW SEGMENT
IFN PURE,<RELOC>
LIT ;PUT LITERALS HERE
END ABACUS