Trailing-Edge
-
PDP-10 Archives
-
BB-D868D-BM
-
4-sources/verify.mac
There are 21 other files named verify.mac in the archive. Click here to see a list.
;<4.UTILITIES>VERIFY.MAC.6, 3-Jan-80 15:27:57, EDIT BY R.ACE
;UPDATE COPYRIGHT DATE
;<4.UTILITIES>VERIFY.MAC.5, 22-Apr-79 18:51:46, Edit by REILLY
;Add new UETP-TALK.MAC and fix routine UETPER
;<4.UTILITIES>VERIFY.MAC.3, 14-Mar-79 11:20:43, Edit by REILLY
;Replace old routine to talk to the UETP with the new
;<4.UTILITIES>VERIFY.MAC.2, 12-Mar-79 14:26:32, EDIT BY KONEN
;UPDATE COPYRIGHT FOR RELEASE 4
;<4.UTILITIES>VERIFY.MAC.2, 23-Jan-79 10:41:59, Edit by KONEN
;UPDATE VERSION NUMBER FOR RELEASE 4
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1976,1977,1978,1979,1980 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
TITLE VERIFY - PROGRAM TO VERIFY FILE VERSIONS
ENTRY VERIFY
SEARCH MONSYM,MACSYM
.REQUIRE SYS:MACREL
SALL
VMAJOR==4 ;MAJOR VERSION #
VMINOR==1 ;MINOR VERSION #
VEDIT==4 ;EDIT NUMBER
VWHO==0 ;CUSTOMER EDIT
VERVER==<VWHO>B2+<VMAJOR>B11+<VMINOR>B17+VEDIT
T1=1
T2=2
T3=3
T4=4
Q1=5
Q2=6
Q3=7
P1=10
P2=11
P3=12
P4=13
P5=14
P6=15
CX=16
P=17
.JBVER==137
STRLEN==100 ;LENGTH OF STRING SPACE
STRLNC==STRLEN*5-1 ;NUMBER OF CHARACTERS IN A STRING
VERPGA==100 ;WHERE TO MAP THE VERSION NUMBER PAGE
VERPAG==VERPGA_11
CHKPGA==101 ;CHECKSUM PAGE
CHKPAG==CHKPGA_11
DEFINE ERRMES (TEXT) <
JSP [ HRROI T1,[ASCIZ\? TEXT\]
PSOUT
HALTF
JRST START]>
DEFINE CHKTYP (TYP) <
CAIE T1,.CM'TYP
ERRMES (<UNEXPECTED TYPE CODE RETURNED FROM "PARSE">)>
DEFINE SAVEPQ <
JSP CX,SAVPQ>
DEFINE SAVEP <
JSP CX,SAVP>
DEFINE TYPMSG (TEXT) <
HRROI T1,[ASCIZ/
? TEXT
/]
PSOUT>
ENTVEC: JRST START ;START ADR
JRST START ;REENTER ADR
EXP VERVER ;VERSION NUMBER
START: RESET ;INIT THE WORLD
START1: MOVE P,[IOWD PDLEN,PDL] ;SET UP A STACK
HRROI T1,[ASCIZ/VERIFY> /]
MOVEI T2,COMTAB ;GET ADR OF COMMAND TABLE
MOVEI T3,ANSWER ;GET POINTER TO ANSWER AREA
CALL PARSE ;GO PARSE THE NEXT COMMAND
ERRMES (<? INVALID COMMAND TABLE FORMAT>)
MOVEI P1,ANSWER ;GET A POINTER TO THE ANSWER BLOCK
HLRZ T1,(P1) ;GET THE TYPE CODE
CHKTYP (KEY) ;MUST BE A KEY WORD
HRRZ T1,(P1) ;GET ADR OF ROUTINE
AOS P1 ;SET UP POINTER
CALL (T1) ;DISPATCH TO THE NEXT LEVEL
JRST START1 ;GO PROMPT AGAIN
;THE CONNECT COMMAND
CONN: SETZM UETPF ;INIT UETP FLAG
HLRZ T1,(P1) ;GET TYPE CODE
CHKTYP (FLD)
HRRZ T1,(P1) ;GET POINTER TO FIELD
MOVEI T1,ANSWER(T1) ;GET ADR OF FIRST WORD
HRLI T1,(POINT 7,0)
MOVE T2,[POINT 7,NAME] ;GET POINTER TO NAME STRING
MOVEI T3,6 ;NAME IS LIMITED TO 6 CHARS
CONN1: ILDB T4,T1 ;GET NEXT CHAR IN NAME STRING
IDPB T4,T2 ;STORE THE CHAR
JUMPE T4,CONN2 ;IF NULL, THEN DONE
SOJGE T3,CONN1 ;LOOP BACK FOR NEXT CHAR
TYPMSG <NAME MUST BE SIX CHARACTERS OR LESS>
RET
CONN2: CALL UETINI ;INIT UETP ROUTINES
JRST [ CALL UETPER ;FAILED
RET]
HRROI T1,NAME ;AND SEND THE MINOR MESSAGE
HRROI T2,[ASCIZ/MINOR/]
HRROI T3,[ASCIZ/Start of verification/]
CALL UETSND
JRST [ CALL UETPER ;FAILED
RET]
SETOM UETPF ;MARK THAT UETP IS BEING USED
RET
;THE VERIFY COMMAND
VERIFY: STKVAR <LSTJFN,<CURLIN,STRLEN>,<TSTSTR,STRLEN>>
HLRZ T1,(P1) ;GET THE NEXT TYPE CODE
CHKTYP (FIL) ;INPUT FILE
HRRZ T1,(P1) ;GET POINTER TO JFN
MOVE T1,ANSWER(T1) ;GET THE JFN
MOVEM T1,LSTJFN ;SAVE THE JFN
VER1: HRRZ T1,LSTJFN ;GET THE JFN
MOVE T2,[070000,,OF%RD]
OPENF ;OPEN THE FILE FOR READ
JRST ERROR ;FAILED TO OPEN THE FILE
CALL VFLMES ;TYPE OUT THE NAME OF THE LIST FILE
VER2: HRRZ T1,LSTJFN ;GET THE JFN OF THE LIST
HRROI T2,CURLIN ;GET POINTER TO THE CURRENT LINE
MOVEI T3,STRLNC ;GET NUMBER OF CHARACTERS IN STRING
MOVEI T4,12 ;TERMINATE ON LINE FEED
SIN ;READ IN THE NEXT LINE
ERJMP [HRRZ T1,LSTJFN ;END OF FILE REACHED
CLOSF
JFCL
MOVE T1,LSTJFN ;GET JFN AGAIN
GNJFN ;STEP TO THE NEXT FILE LIST
ERJMP R ;DONE
JRST VER1] ;LOOP BACK FOR ALL LIST FILES
SETZ T3, ;FINISH WITH A NULL
IDPB T3,T2
HRROI T1,CURLIN ;GET A POINTER TO THIS LINE
HRROI T2,TSTSTR ;GET A POINTER TO THE TEST STRING
CALL BLDSTR ;GO BUILD THE TEST STRING
JRST VER2 ;AN ERROR OCCURRED, SKIP THIS FILE
HRROI T1,CURLIN ;NOW COMPARE THE STRINGS
HRROI T2,TSTSTR
STCMP
JUMPE T1,VER3 ;MATCHED
HRROI T1,CURLIN ;DID NOT MATCH
HRROI T2,TSTSTR ;GO TYPE OUT THE ERROR MESSAGE
CALL VFMES
VER3: JRST VER2 ;LOOP BACK FOR ALL FILES
;ROUTINE TO BUILD THE TEST STRING
;ACCEPTS IN T1/ POINTER TO CURRENT LINE
; T2/ POINTER TO TEST STRING
; CALL BLDSTR
;RETURNS +1: FAILED
; +2: SUCCESS, TEST STRING BUILT
BLDSTR: ASUBR <BLDSTC,BLDSTT,BLDSTJ>
CALL GETJFN ;GET A JFN ON THE TEST FILE
JRST [ MOVE T2,BLDSTC ;GET THE CURRENT LINE POINTER
CALL NSFMES ;GO PRINT OUT THE ERROR MESSAGE
RET]
MOVEM T1,BLDSTJ ;SAVE THE JFN
CALL CHKSUM ;GO CALCULATE THE CHECK SUM
JRST [ MOVE T2,BLDSTC ;GET POINTER TO CURRENT LINE
CALL CHKMES ;OUTPUT THE ERROR MESSAGE
RET]
MOVE T1,BLDSTJ ;GET TEST JFN AGAIN
CALL GETVER ;GET THE VERSION
JRST [ MOVE T2,BLDSTC ;GET POINTER TO CURRENT LINE
CALL VERMES ;OUTPUT THE ERROR MESSAGE
JRST BLDST1]
MOVE T1,T2 ;GET POINTER TO TEST STRING
CALL CRLF ;APPEND A CRLF
MOVE T2,T1 ;GET UPDATED STRING POINTER
BLDST1: HRRZ T1,BLDSTJ ;GET JFN
CLOSF ;CLOSE IT
JFCL
HRRZ T1,BLDSTJ
RLJFN ;AND RELEASE IT
JFCL
RETSKP ;DONE
;ROUTINE TO TYPE OUT FILE LIST BEING VERIFIED
;ACCEPTS IN T1/ JFN
VFLMES: ASUBR <VFLMSJ>
HRROI T1,USTRNG ;BUILD STRING
HRROI T2,[ASCIZ/Verifying file: /]
SETZ T3,
SOUT
HRRZ T2,VFLMSJ ;GET JFN OF THE FILE
SETZ T3, ;USE DEFAULT FORM
JFNS
HRROI T2,[ASCIZ/
/]
SOUT
SKIPN UETPF ;SENDING TO UETP?
JRST [ HRROI T1,USTRNG ;NO
PSOUT
RET]
HRROI T1,NAME ;YES
HRROI T2,[ASCIZ/MINOR/] ;SEND MESSAGE TO LOG FILE
HRROI T3,USTRNG
CALL UETSND
JRST [ CALL UETPER ;FAILED
RET]
RET
;ROUTINES TO TYPE OUT ERROR MESSAGES DURING BUILDING OF TEST STRING
;ACCEPTS IN T1/ ERROR CODE
; T2/ POINTER TO CURRENT LINE STRING
VERMES: JRST NSFMES
CHKMES: TDZA T4,T4 ;0 INDEX
NSFMES: MOVEI T4,1 ;1 INDEX
ASUBR <NSFMSC,NSFMSP>
HRROI T1,USTRNG ;SET UP TO BUILD STRING
HRROI T2,[ASCIZ/? Verification error:
Error "/]
SETZ T3,
SOUT
MOVE T2,NSFMSC ;GET THE ERROR CODE
HRLI T2,.FHSLF
SETZ T3,
ERSTR
JFCL
JRST [ HRLI T2,.FHSLF ;GET LAST ERROR CODE
ERSTR
JFCL
JFCL
JRST .+1]
MOVE T2,MES1(T4) ;GET REMANIDER OF MESSAGE
SOUT
MOVE T2,NSFMSP ;GET POINTER TO THIS LINE
SOUT
HRROI T1,USTRNG
CALL TYPERR ;GO OUTPUT THE ERROR MESSAGE
RET
MES1: -1,,[ASCIZ/" occurred during the check sum calculation on line:
/]
-1,,[ASCIZ/" occurred in line:
/]
;ROUTINE TO TYPE THE VERIFICATION ERROR MESSAGE
;ACCEPTS IN T1/ CURRENT LINE
; T2/ TEST STRING
VFMES: ASUBR <VFMSC,VFMST>
HRROI T1,USTRNG ;BUILD THE STRING
HRROI T2,[ASCIZ/? Mismatch occurred during verification:
Currently installed file: /]
SETZ T3,
SOUT
MOVE T2,VFMST ;GET TEST STRING
SOUT
HRROI T2,[ASCIZ/ Correct file: /]
SOUT
MOVE T2,VFMSC ;GET CURRENT LINE
SOUT
HRROI T1,USTRNG
CALL TYPERR ;GO TYPE THE ERROR MESSAGE
RET
TYPERR: SKIPN UETPF ;SENDING TO UETP?
JRST [ PSOUT
RET]
MOVE T3,T1
HRROI T1,NAME
HRROI T2,[ASCIZ/ERROR/]
CALL UETSND
JRST [ CALL UETPER
RET]
RET
;ROUTINE TO GET A JFN FOR THE FILE SPECIFIED IN THE CURRENT LINE
;ACCEPTS IN T1/ POINTER TO CURRENT LINE OF LIST
; T2/ POINTER TO OUTPUT STRING
; CALL GETJFN
;RETURNS +1: FAILED, T1/ ERROR CODE
; +2: T1/ JFN
; T2/ UPDATED STRING POINTER TO OUTPUT STRING
GETJFN: TLC T1,-1 ;CONVERT BYTE POINTERS
TLCN T1,-1
HRLI T1,(POINT 7,0)
TLC T2,-1
TLCN T2,-1
HRLI T2,(POINT 7,0)
ASUBR <GETJFI,GETJFO>
MOVX T1,GJ%OLD!GJ%SHT ;GET A JFN ON THE FILE
MOVE T2,GETJFI ;GET POINTER TO THE INPUT STRING
GTJFN
RET ;FAILED
SETZ T4, ;INIT COUNT OF CHARS IN FILE NAME
GETJF1: ILDB T3,GETJFI ;COPY THE STRING TO THE OUTPUT STRING
JUMPE T3,GETJF2 ;IF NULL, THEN DONE
CAIE T3,15 ;CR?
CAIN T3,12 ;OR LF?
JRST GETJF2 ;YES, DONE
CAMN T2,GETJFI ;STRING POINTER MATCH YET?
JRST GETJF2 ;YES, DONE
IDPB T3,GETJFO ;STORE THIS CHAR
AOJA T4,GETJF1 ;COUNT UP THE CHARS IN THE FILE NAME
GETJF2: MOVNS T4 ;GET THE NUMBER OF SPACES TO OUTPUT
ADDI T4,^D20
MOVEI T3," " ;GET A SPACE
GETJF3: IDPB T3,GETJFO ;PUT THE SP[ACE INTO THE OUTPUT STRING
SOJG T4,GETJF3 ;LOOP BACK FOR ALL SPACES
MOVEI T3,0 ;END THE STRING WITH A NULL
MOVE T2,GETJFO ;RETURN THE UPDATED POINTER
IDPB T3,GETJFO
RETSKP
;ROUTINE TO CALCULATE THE CHECK SUM OF A FILE
;ACCEPTS IN T1/ JFN
; T2/ OUTPUT STRING POINTER
; CALL CHKSUM
;RETURNS +1: ERROR, ERROR CODE IS IN T1
; +2: UPDATED STRING POINTER IN T2
CHKSUM: STKVAR <CHKSMJ,CHKSMS,CHKSMP,CHKSME,CHKSMT,CHKSMA,CHKSMC>
MOVEM T1,CHKSMJ ;SAVE THE JFN
MOVEM T2,CHKSMS ;SAVE THE STRING POINTER
SETZM CHKSMC ;INIT THE CHECK SUM
SETZM CHKSME ;INIT ERROR CODE
MOVE T2,[44B5!OF%RD] ;OPEN THE FILE
OPENF
RET ;FAILED TO OPEN THE FILE
HRLZ T1,CHKSMJ ;SET UP THE PMAP POINTER
CHKSM1: HRRZM T1,CHKSMP ;SAVE THE PAGE NUMBER
MOVE T2,[.FHSLF,,CHKPGA]
FFUFP ;FIND THE NEXT USED PAGE
JRST [ CAIE T1,FFUFX3 ;NO MORE?
MOVEM T1,CHKSME ;SOME OTHER ERROR
JRST CHKSM3] ;ALL DONE
MOVEM T1,CHKSMA ;SAVE THE PAGE ADDRESS
HRRZ T4,T1 ;GET PAGE NUMBER
SUB T4,CHKSMP ;HOLE?
JUMPE T4,CHKSM2
MOVNI T3,(T4) ;YES, GET SIZE OF THE HOLE
HRL T3,T4 ;# OF PAGES ,, - # OF PAGES
MOVE T1,CHKSMC ;GET CHECK SUM VALUE
MOVEM T3,CHKSMT ;SAVE THE PAGE COUNT ON THE STACK
MOVSI T2,-1 ;SET UP FOR ONE WORD OF CHECK SUM
HRRI T2,CHKSMT ;ADD HOLE INTO THE CHECKSUM
CALL CHKSOM ;UPDATE THE CHECKSUM
MOVEM T1,CHKSMC ;SAVE NEW CHECKSUM
CHKSM2: MOVX T3,PM%RD ;MAP IN THE NEXT PAGE
MOVE T1,CHKSMA ;GET FILE PAGE NUMBER
MOVE T2,[.FHSLF,,CHKPGA]
PMAP
MOVSI T2,-1000 ;SET UP COUNT OF THE WORDS
HRRI T2,CHKPAG ;AOBJN POINTER TO THE PAGE
MOVE T1,CHKSMC ;GET THE CURRENT CHECKSUM
CALL CHKSOM ;DO THE CHECKSUM
MOVEM T1,CHKSMC ;SAVE THE UPDATED CHECKSUM
MOVE T1,CHKSMA ;GET THE PAGE ADR AGAIN
AOJA T1,CHKSM1 ;STEP TO THE NEXT PAGE
CHKSM3: SETO T1, ;UNMAP THE PAGE
MOVE T2,[.FHSLF,,CHKPGA]
SETZ T3,
PMAP
MOVX T1,CO%NRJ ;DO NOT RELEASE THE JFN
HRR T1,CHKSMJ ;CLOSE THE JFN
CLOSF
RET ;FAILED
MOVE T1,CHKSMC ;GET THE CHECKSUM
SKIPN CHKSME ;ANY ERRORS?
JRST CHKSM4 ;NO, GO COPY CHECK SUM TO OUTPUT STRING
MOVE T1,CHKSME ;YES, GET THE ERROR CODE
RET
CHKSM4: HLRZ T2,CHKSMC ;MERGE THE CHECKSUM INTO 18 BITS
HRRZ T3,CHKSMC ;GET THE OTHER HALF
ADD T3,T2 ;FOLD THE TWO HALVES TOGETHER
HLRZ T2,T3 ;HANDLE THE OVERFLOW
ADDI T2,(T3)
MOVE T3,[1B0+1B2+1B3+6B17+10]
MOVE T1,CHKSMS ;GET STRING POINTER
NOUT
JRST ERROR
HRROI T2,[ASCIZ/ P /]
SETZ T3,
SOUT
MOVE T2,T1 ;RETURN UPDATED STRING POINTER IN T2
RETSKP
;ROUTINE TO UPDATE THE CHECKSUM VALUE
;ACCEPTS IN T1/ SEED
; T2/ AOBJN POINTER TO DATA TO BE CHECKSUMED
CHKSOM: ROT T1,1
ADD T1,(T2) ;ADD IN THE NEXT WORD
AOBJN T2,CHKSOM ;LOOP BACK FOR ALL WORDS
RET
;ROUTINE TO GET A VERSION NUMBER
;ACCEPTS IN T1/ JFN
; T2/ STRING POINTER TO OUTPUT STRING
GETVER: STKVAR <GETVRJ,GETVRP,GETVRF,<GETVRS,8>>
MOVEM T1,GETVRJ ;SAVE THE JFN
MOVEM T2,GETVRP ;SAVE THE OUTPUT POINTER
HRROI T1,GETVRS ;GET THE FILE TYPE
HRRZ T2,GETVRJ ;FROM THE JFN
MOVSI T3,(2B11) ;ONLY WANT THE FILE TYPE
JFNS
MOVE T1,GETVRS ;GET THE FIRST WORD
TRZ T1,377 ;MASK OFF THE LOW ORDER 8 BITS
CAME T1,[ASCII/EXE/] ;IS THIS AN EXE FILE?
JRST GETVR2 ;NO, THEN NO VERSION NUMBER
SETZ T1, ;GET A FORK FOR THE PROGRAM
CFORK
RET ;COULD NOT GET A FORK
MOVEM T1,GETVRF ;SAVE THE FORK HANDLE
HRLZ T1,GETVRF ;NOW GET THE FILE INTO THE FORK
HRR T1,GETVRJ
GET
ERJMP GETVR1 ;ERROR COULD MEAN NOT AN EXE FILE
MOVE T1,GETVRF ;GET THE FORK HANDLE
CALL GETVN ;GO GET THE VERSION NUMBER
JRST GETVR1 ;NONE THERE
MOVE T2,GETVRP ;GET POINTER TO THE OUTPUT STRING
CALL VERPNT ;OUTPUT THE VERSION NUMBER
MOVEM T2,GETVRP ;SAVE UPDATED STRING POINTER
GETVR1: MOVE T1,GETVRF
KFORK ;KILL THE LOWER FORK
GETVR2: MOVE T2,GETVRP ;GET UPDATED POINTER
RETSKP ;DONE
;ROUTINE TO OUTPUT THE VERSION NUMBER TO A STRING
;ACCEPTS IN T1/ VERSION #
; T2/ STRING POINTER
VERPNT: ASUBR <VERPNV,VERPNP>
MOVE T1,VERPNP ;GET OUTPUT POINTER
LDB T2,[POINT 9,VERPNV,11] ;GET MAJOR VERSION
JUMPE T2,VERPN1 ;IF NONE, SKIP THIS
MOVEI T3,8 ;OCTAL
NOUT
ERJMP ERROR
VERPN1: LDB T2,[POINT 6,VERPNV,17] ;GET THE MINOR VERSION
JUMPE T2,VERPN3 ;IF NONE, SKIP THIS
SUBI T2,1
IDIVI T2,^D26 ;GET LETTERS
JUMPE T2,VERPN2 ;IF NO FIRST LETTER...
MOVEI T2,"A"-1(T2) ;GET LETTER TO TYPE
BOUT
VERPN2: MOVEI T2,"A"(T3) ;GET SECOND LETTER
BOUT
VERPN3: HRRZ T2,VERPNV ;GET THE EDIT NUMBER
JUMPE T2,VERPN4
MOVEI T2,"("
BOUT
HRRZ T2,VERPNV ;GET EDIT NUMBER AGAIN
MOVEI T3,8 ;OCTAL
NOUT
ERJMP ERROR
MOVEI T2,")"
BOUT
VERPN4: LDB T3,[POINT 3,VERPNV,2]
JUMPE T3,VERPN5 ;CUSTOMER VERSION?
MOVEI T2,"-"
BOUT
MOVE T2,T3 ;OUTPUT THE NUMBER
MOVEI T3,8
NOUT
ERJMP ERROR
VERPN5: MOVE T2,T1 ;GET UPDATED STRING POINTER
RET
;ROUTINE TO GET A VERSION NUMBER FROM A FORK
;ACCEPTS IN T1/ FORK HANDLE
;RETURNS +1: NO VERSION NUMBER
; +2: T1/ VERSION NUMBER
GETVN: ASUBR <GETVNF>
GEVEC ;GET ENTRY VECTOR
HLRZ T1,T2 ;GET TYPE
CAIE T1,(<JRST>) ;TOPS-10?
JRST [ CAIGE T1,3 ;NO, LONG ENOUGH?
RET ;NO
MOVEI T2,2(T2) ;GET ADR OF VERSION NUMBER
JRST GETVN1]
MOVEI T2,.JBVER
GETVN1: MOVE T1,GETVNF
CALL RDVER ;GO READ THAT ADDRESS
RET ;NO PAGE THERE
RETSKP ;DONE
;ROUTINE TO READ A WORD FROM A FORK
;ACCEPTS IN T1/ FORK HANDLE
;RETURNS +1: NO PAGE THERE
; +2: T1/ ANSWER
RDVER: ASUBR <RDVERF,RDVERA>
HRLZ T1,RDVERF ;GET THE FORK HANDLE
LSH T2,-11 ;GET PAGE ADR
HRR T1,T2
RPACS ;SEE IF THE PAGE EXISTS
TXNN T2,PA%PEX
RET ;DOES NOT EXIST
MOVE T2,[.FHSLF,,VERPGA]
MOVX T3,PM%RD ;MAP THE PAGE IN
PMAP
MOVE T4,RDVERA ;GET ADR AGAIN
ANDI T4,777 ;JUST GET THE OFFSET
MOVE T4,VERPAG(T4) ;GET THE WORD
SETO T1, ;UNMAP THE PAGE
PMAP
SKIPN T1,T4 ;IS THERE A VERSION NUMBER?
RET ;NO
RETSKP ;YES
;EXIT COMMAND
EXITC: HRROI T1,NAME ;END OF TEST
HRROI T2,[ASCIZ/END/]
HRROI T3,[ASCIZ/End of verification/]
CALL UETSND
JRST [ CALL UETPER
JRST .+1]
HALTF
JRST START
;UPDATE COMMAND
UPDATE: SAVEPQ
STKVAR <INJFN,OUTJFN,<CURLIN,STRLEN>,<TSTSTR,STRLEN>>
HLRZ T1,(P1) ;GET THE TYPE CODE
CHKTYP (IFI)
HRRZ T1,(P1) ;GET THE POINTER TO THE JFN
MOVE T1,ANSWER(T1) ;GET THE JFN
MOVEM T1,INJFN
MOVE T2,[070000,,OF%RD] ;OPEN THE FILE
OPENF
JRST ERROR
CALL GETOJ ;GET THE OUTPUT JFN
JRST ERROR
MOVEM T1,OUTJFN ;SAVE THE OUTPUT JFN
MOVE T2,[070000,,OF%WR]
OPENF
JRST ERROR
SETZ Q1, ;INIT ERROR COUNTER
UPDAT1: MOVE T1,INJFN ;GET THE INPUT JFN
HRROI T2,CURLIN
MOVEI T3,STRLNC
MOVEI T4,12 ;READ UNTIL A LINE FEED IS SEEN
SIN
ERJMP UPDAT2 ;DONE
SETZ T3, ;FINISH WITH A NULL
IDPB T3,T2
HRROI T1,CURLIN ;NOW BUILD THE TEST STRING
HRROI T2,TSTSTR
CALL BLDSTR
AOJA Q1,UPDAT1 ;ERROR WHILE BUILDING STRING
HRROI T2,TSTSTR ;NOW OUTPUT THE TEST STRING
SETZ T3,
HRRZ T1,OUTJFN
SOUT
JRST UPDAT1 ;LOOP BACK FOR OTHER FILES IN LIST
UPDAT2: HRRZ T1,INJFN ;CLOSE THE JFNS
CLOSF
JFCL
HRRZ T1,OUTJFN
SKIPE Q1 ;ANY ERRORS?
TXO T1,CZ%ABT ;YES, DO NOT OVERWRITE THE FILE
CLOSF
JRST ERROR
RET
;ROUTINE TO GET AN OUTPUT JFN
;ACCEPTS IN T1/ JFN
;RETURNS +1: FAILED
; +2: T1/ OUTPUT JFN
GETOJ: STKVAR <<GETOJS,20>>
HRRZ T2,T1 ;GET JFN
HRROI T1,GETOJS
MOVE T3,[2B8!2B11!JS%PAF] ;GET NAME.TYP
JFNS
MOVX T1,GJ%FOU!GJ%SHT
HRROI T2,GETOJS ;GET THE OUTPUT JFN
GTJFN
RET ;FAILED
RETSKP ;OK
;ROUTINE TO APPEND A CRLF ONTO A STRING
;ACCEPTS IN T1/ STRING POINTER
CRLF: HRROI T2,[ASCIZ/
/]
SETZ T3,
SOUT
RET
;ROUTINE TO TYPE OUT AN ERROR MESSAGE
ERROR: MOVEI T1,.PRIOU
HRLOI T2,.FHSLF
SETZ T3,
ERSTR
JFCL
JFCL
JRST START
;ROUTINE TO TYPE OUT ERROR MESSAGE FROM UETP
UETPER: CAMN T2,[-1] ;IS THIS AN ERROR CODE?
RET ;NO, THEN MESSAGE WAS ALREADY OUTPUT
HRROI T1,[ASCIZ/
? COMMUNICATION TO UETP FAILED BECAUSE: /]
PSOUT
MOVEI T1,.PRIOU ;OUTPUT MESSAGE TO TTY
MOVE T2,[.FHSLF,,-1] ;[4] LAST ERROR FROM THIS FORK
SETZ T3,
ERSTR
JFCL
JFCL
HRROI T1,[ASCIZ/
/]
PSOUT
RET
SUBTTL Subroutine to communicate to the UETP
;[BEGIN OF UETP-TALK.MAC]
;
; This program will communicate with the UETP, via
; IPCF. The use of this program is intended to be for
; those programs that want to talk directly with the UETP.
; The usual means of communication with the UETP is through
; the SENDER program. Not all of the features of SENDER
; are implemented.
; There are two routines UETINI and UETSND.
;
; UETINI - UETINI takes no arguments and initializes the UETP interface.
; (It gets the proper PID)
; RETURNS: +1,always
; UETSND - UETSND take arguments and is used for sending that data to the
; UETP.
;ACCEPTS: T1/ASCIZ POINTER TO NAME OF TEST (6 CHARACTERS MAX)
; T2/ASCIZ POINTER TO TYPE OF MESSAGE (SUGGESTION 'MAJOR')
; TYPES ARE:
; START - START OF TEST MESSAGE
; END - END OF TEST MESSAGE
; ERROR - ERROR MESSAGE - CAUSES ERROR COUNT TO GO UP
; MAJOR - GENERAL MESSAGE FOR LOG AND TTY
; MINOR - GENERAL MESSAGE FOR LOG ONLY
; T3/ASCIZ POINTER TO TEXT STRING TO BE SENT
;RETURNS: +1,ERROR T2/<PROCESS ID,,ERROR CODE> IF MONITOR ERROR
; -1 IF NON-JSYS ERROR
; T4/ADDRESS OF ERROR
;
; +2,OTHERWISE
SEARCH MONSYM, MACSYM
.REQUIRE SYS:MACREL
SALL
TSTFLG==0
; ACCUMULATOR DEFINITIONS
T1=1 ;TEMPORARY
T2=2 ;TEMPORARY
T3=3 ;TEMPORARY
T4=4 ;TEMPORARY
Q1=5 ;PRESERVED
Q2=6 ;PRESERVED
Q3=7 ;PRESERVED
P1=10 ;PRESERVED
P2=11 ;PRESERVED
P3=12 ;PRESERVED
P4=13 ;PRESERVED
P5=14 ;PRESERVED
P6=15 ;PRESERVED (CAUTION, USED BY SOME MACROS IN MACSYM)
CX=16 ;RESERVED FOR SUPPORT CODE
P=17 ;PUSH-DOWN POINTER
NCHPW==5 ;NUMBER OF ASCIZ CHARACTERS PER WORD
BUFSIZ==200 ;SIZE OF INPUT TEXT BUFFER
IFN TSTFLG,<
PDLEN==50 ;PUSH-DOWN STACK LENGTH
>
RETRY==2000 ;COUNT OF NUMBER OF MSEND RETRIES
SUBTTL TEST ROUTINE
IFN TSTFLG,<
START: MOVE P,[IOWD PDLEN,PDL] ;SET UP STACK
CALL UETINI
HRROI T1,[ASCIZ/VERIFY/]
HRROI T2,[ASCIZ/MAJOR/]
HRROI T3,[ASCIZ/Testing of UETP macro interface/]
CALL UETSND
JRST [ HRROI T1,[ASCIZ/Error has occured/]
PSOUT
HALTF]
HALTF
>
SUBTTL MAIN ENTRY POINT AND INITIALIZATION
UETINI:
;INITIALIZE OUR PID
MOVEI T1,.MUCRE ;PARM FOR THE PID CREATE
MOVEM T1,IPCOM ;PLACE IN CONTROL BLOCK
MOVE T1,[.FHSLF] ;MAKE OUT PID JOB WIDE
MOVEM T1,IPCOM+1 ;PLACE IN CONTROL BLOCK
MOVEI T1,3 ;TWO WORD PARM
MOVEI T2,IPCOM ;ADDR OF PARM CONTROL BLOCK
MUTIL ; JSYS-IPCF UTILITY- UP PID
ERJMP [JSP T4,ERROUT ;GET ERRMSG AND RETURN
RET]
MOVE T1,IPCOM+2 ;LOAD THE JUST CREATED PID
MOVEM T1,OURPID ;AND SAVE PERMANENTLY
; GET <SYSTEM>INFO PID
MOVEI T1,.MUGTI ;FUNCTION TO GET <SYSTEM>INFO PID
MOVEM T1,IPCOM ;PLACE IN CONTROL BLOCK
MOVE T1,OURPID ;GET OUR PID FOR IDENTIFICATION
MOVEM T1,IPCOM+1
MOVEI T1,3 ;TWO WORD PARM
MOVEI T2,IPCOM ;ADDRESS OF PARM CONTROL BLOCK
MUTIL ;JSYS- GET <SYSTEM>INFO PID
ERJMP [JSP T4,ERROUT ;GET ERRMSG AND RETURN
RET]
MOVE T1,IPCOM+2 ;LOAD THE <SYSTEM>INFO PID
MOVEM T1,SYSPID ;SAVE IN PERMANENT STORAGE
; GET PID OF THE UETP ("UETP-DIRECTORY #")
MOVEI Q1,IPCOM ;POINT TO BASE IPCF BLOCK
MOVE T1,[1234,,.IPCIW] ;IDENTITY CODE,,GET PID CODE
MOVEM T1,.IPCI0(Q1) ;INTO IPCF COMMUNICATION BLOCK
SETZM .IPCI1(Q1) ;NO ONE ELSE TO GET THIS RESPONSE
SETZM .IPCI2(Q1) ;[4] CLEAR WORD BEFORE SOUT
HRROI T1,.IPCI2(Q1) ;PLACE STRING IN THERE
HRROI T2,[ASCIZ/UETP-/] ;NAME WE WANT PID FOR
SETZ T3, ;WRITE ASCIZ STRING
SOUT
MOVE Q2,T1 ;SAVE THE STRING POINTER
HRROI T1,-1 ;NOW GET DIRECTORY NUMBER WHICH
MOVE T2,[-1,,4] ;WILL GIVE US THE DIRECTORY NAME
MOVEI T3,.JIDNO
GETJI
ERJMP [JSP T4,ERROUT ;GET ERRMSG AND RETURN
RET]
MOVE T1,Q2 ;POINTER FOR WHERE IT'S GOING IN MSGBUF
MOVE T2,T4 ;T4 HAS DIRECTORY NUMBER IN IT
MOVE T3,[NO%MAG+^D8] ;No magnitude, octal number
NOUT
ERJMP [JSP T4,ERROUT ;GET ERRMSG AND RETURN
RET]
;...
;...
MOVE T1,[IPCOML,,IPCOM] ;LENGTH,,ADDRESS TO SUBROUTINE
CALL SYSEND ;SEND REQUEST TO <SYSTEM>INFO
CALL SYSRCV ;GO GET REPLY
MOVE T1,PDB ;GET <SYSTEM>INFO RESPONSE FLAGS
TXNE T1,IP%CFE ;SKIP IF NO ERRORS
JRST [JSP T4,ERROUT ;GET ERRMSG AND RETURN
RET]
MOVE T1,IPCOM+.IPCI1 ;GET THE PID
MOVEM T1,UETPID ;AND SAVE FOR LATER USE
RETSKP ;AND RETURN
SUBTTL <SYSTEM>INFO SERVICE ROUTINES
; ROUTINES TO SEND AND RECIEVE <SYSTEM>INFO MESSAGES
; SEND THE MESSAGE TO <SYSTEM>INFO
SYSEND: MOVEM T1,SYSPDB+.IPCFP ;PARM PASSED IS MESSAGE
MOVE T1,OURPID ;TELL <SYSTEM>INFO WHO WE ARE
MOVEM T1,SYSPDB+.IPCFS ;INTO CONTROL BLOCK
SETZM SYSPDB+.IPCFR ;ZERO MEANS GO TO <SYSTEM>INFO
SETZM SYSPDB+.IPCFL ;WE HAVE NO FLAGS TO PASS
MOVEI T1,PDBLEN ;LENGTH OF PDB
MOVEI T2,SYSPDB ;ADDRESS OF CONTROL BLOCK
MSEND ; SEND THE MESSAGE
ERJMP [JSP T4,ERROUT ;GET ERRMSG AND RETURN
RET]
MOVE T1,SYSPDB+.IPCFL ;GET ERROR FLAGS
AND T1,[IP%CFE] ;ISOLATE ERROR FLAGS
SKIPE T1 ;ANY ERROR IS FATAL
JRST [HRROI T1,[ASCIZ/ERROR RETURN FROM MSEND JSYS AT SYSEND:/]
PSOUT
SETOM T2 ;INDICATE NON-JSYS ERROR
RET] ;SEND MSG TO CTY AND ABORT
POPJ P, ;RETURN
; RECIEVE MESSAGES FROM <SYSTEM>INFO
SYSRCV: ;ERROR IF NO MESSAGES
MOVEM T1,PDB+.IPCFL ;NO FLAGS
SETZM PDB+.IPCFS ;ZERO OUT SENDER'S PID
MOVE T1,OURPID ;GET OUR PID
MOVEM T1,PDB+.IPCFR ; INTO RECIEVER'S WORD
MOVE T1,[IPCOML,,IPCOM] ;LENGTH AND PLACE FOR MESSAGE
MOVEM T1,PDB+.IPCFP ;INTO THE CONTROL BLOCK
MOVEI T1,PDBLEN ;LENGTH OF PDB
MOVEI T2,PDB ;ADDRESS OF PDB
MRECV ;GET THE MESSAGE
ERJMP [JSP T4,ERROUT ;GET ERRMSG AND RETURN
RET]
MOVE T1,PDB+.IPCFL ;GET THE FLAGS
AND T1,[IP%CFC] ;ISOLATE THE SYSTEM FLAGS
CAIN T1,<.IPCCF>B32 ;SKIP IF NOT <SYSTEM>INFO MSG
POPJ P, ;RETURN WITH <SYSTEM>INFO MSG
HRROI T1,[ASCIZ/?ERROR AT SYSRCV:, GETTING UNKNOWN IPCF MSG'S/]
PSOUT
JRST SYSRCV ;GET NEXT MESSAGE
SUBTTL UETSND - ROUTINE TO SEND MESSAGES TO THE UETP
;ACCEPTS: T1/POINTER TO NAME OF TEST (MAX 6 CHARACTERS)
; T2/POINTER TO MESSAGE TYPE (MAX 6 CHARACTERS)
; T3/POINTER TO STRING TO BE SENT
;CALL: CALL UETSND
;RETURNS: +1,ALWAYS
;
UETSND: SAVEAC <Q1,P1,P2,P3,P4>
SETZM MSGREC ;ZERO OUT THE ASCIZ FIELDS
MOVE P4,[MSGREC,,MSGREC+1] ;FOR THE BLT
BLT P4,MSGREC+RECLEN-1 ;ZERO IT ALL
DMOVEM T1,P1 ;SAVE THE LENGTHS
MOVE T2,T3 ;POINTER TO SOURCE INTO PARM REG
MOVEI T3,RECLEN ;MAX BYTES TO MOVE (ASCIZ STRING)
HRROI T1,MSGREC ;DESTINATION POINTER
SETZ T4,
SOUT ;GO WRITE THE BYTES
MOVEI T2,15 ;ADD END OF LINE CHARACTER
DPB T2,T1 ;AND ADD TO FIELD
MOVEI T2,12 ;ADD END OF LINE CHARACTER
IDPB T2,T1 ;AND ADD TO FIELD
SUBI T3,RECLEN ;COMPUTE BYTES ADDED
MOVN P3,30(T3) ;SAVE POSITIVE LENGTH
HRROI T1,DEFTYP ;NOW MOVE THE MESSAGE TYPE
MOVE T2,P2
MOVEI T3,6 ;MAX OF SIX CHARACTERS
SETZ T4,
SOUT
HRROI T1,TNAME ;NOW MOVE THE NAME OF THE TEST
MOVE T2,P1
SETZ T4,
MOVEI T3,6
SOUT
HRROI T1,DATE ;TIME STAMP ALL RECORDS
HRREI T2,-1 ;CURRENT DATE AND TIME
SETZ T3, ;DEFAULT FORMAT
ODTIM ;GET THE TIME AND DATE INTO RECORD
HRROI T1,-5 ;GET CPU TIME USED FOR WHOLE JOB
RUNTM ;GO GET IT
PUSH P,T2 ;SAVE FOR LATER COMPUTE
; ...
; ...
IDIV T1,T2 ;CONVERT TO SECONDS
HRROI T4,CPUTIM ;WHERE TO PUT CPU TIME USED
CALL TIMOUT ;OUTPUT STRING
POP P,T2 ;RETURN CONVERSION FACTOR
MOVE T1,T3 ;MOVE CONSOLE TIME INTO PARM REG
IDIV T1,T2 ;CONVERT TO SECONDS
HRROI T4,CNSTIM ;WHERE TO PUT CONSOLE TIME
CALL TIMOUT ;CONVERT TO ASCIZ AND OUTPUT
SETZM PDB+.IPCFL ;NO BITS TO SET
MOVEI Q1,RETRY ;LOAD THE RETRY COUNT FOR ERROR SENDS
MOVE T1,OURPID ;PUT OUR PID IN
MOVEM T1,PDB+.IPCFS ;PDB SENDER FIELD
MOVE T1,UETPID ;DO THE SAME
MOVEM T1,PDB+.IPCFR ; FOR THE RECIEVER
MOVEM T1,PDB+.IPCFP ;SAVE THE INFO IN PDB POINTER FIELD
MOVE T1,[BASERC,,IPCFPG] ;COPY PAGE TO BE IPCF'ED
BLT T1,IPCFPG+777 ;MOVE WHOLE PAGE
MOVEI Q1,RETRY ;LOAD THE RETRY COUNT FOR ERROR SENDS
MOVX T1,IP%CFV ;FLAG INDICATES SHIPPING ONE PAGE
MOVEM T1,PDB+.IPCFL ;NO FLAGS TO SET
MOVE T1,[1000,,<IPCFPG/1000>] ;SHIPPING ONE PAGE AT IPCFPG
MOVEM T1,PDB+.IPCFP ;SAVE THE INFO IN PDB POINTER FIELD
SENDIT: MOVEI T1,PDBLEN ;LENGTH OF PDB
MOVEI T2,PDB ;ADDRESS OF PDB
MSEND ;SEND THE STRING
JRST .+2 ;ERROR - HANDLE WITH RETRIES
RETSKP ;NO ERROR - ALL OK - RETURN
CAIN T1,IPCFX6 ;WAS IT SEND QUOTA EXCEEDED?
JRST TRYAGN ;YES - WELL SEND ANOTHER ONE
CAIN T1,IPCFX7 ;WAS IT RECEIVER'S QUOTA EXCEEDED?
JRST TRYAGN ;YES - WELL SEND ANOTHER ONE
CAIN T1,IPCFX8 ;WAS IT IPCF FREE SPACE EXHAUSTED?
JRST TRYAGN ;YES - WELL SEND ANOTHER ONE
CAIN T1,IPCFX5 ;WAS IT RECEIVER'S PID DISABLED
JRST TRYAGN ;YES - WELL SEND ANOTHER ONE
TYPER: HRROI T1,[ASCIZ/?ERROR IN SENDING IPCF MESSAGES, AT SENDIT: ./]
PSOUT
SETOM T2 ;INDICATE NON-JSYS ERROR
RET ;SEND ERROR MESSAGES AND ABORT
TRYAGN: MOVEI T1,100 ;WE'LL WAIT .1 SECONDS BEFORE WE RETRY
DISMS ;GO WAIT FOR THAT .1 SECONDS
SOJG Q1,SENDIT ;RETRY SENDING "RETRY" TIMES
JRST TYPER ;RETRIES FAILED TELL USER
SUBTTL TIMOUT - SUBROUTINE TO OUTPUT TIME IN T1 IN HH:MM:SS FORMAT
;
;ACCEPTS: T1/ TIME TO BE OUTPUT IN SECONDS
; T4/ OUTPUT DESTINATION POINTER
;
;CALL: CALL TIMOUT
;RETURNS: +1,ALWAYS
;
TIMOUT: SAVEAC <T1,T2,T3> ;SAVE THE FIRST 3 AC'S
MOVE T2,T1 ;MOVE FOR JSYS SENDING
MOVE T1,T4 ;GET THE OUTPUT DESIGNATOR
IDIVI T2,^D3600 ;GET THE HOURS QUANTITY
PUSH P,T3 ;SAVE REMAINDER FOR LATER OUTPUT
MOVEI T3,^D10 ;OUTPUT IN BASE 10
NOUT ;OUTPUT THE NUMBER
ERJMP [JSP T4,ERROUT ;GET ERRMSG AND RETURN
RET]
MOVEI T2,":" ;OUTPUT COLON SEPERATOR
BOUT ;OUTPUT THE BYTE
POP P,T2 ;GET BACK REMAINDER AND INTO AC 2
IDIVI T2,^D60 ;MAKE INTO MINUTES
PUSH P,T3 ;SAVE REMAINDER (SECONDS)
MOVE T3,[NO%LFL+NO%ZRO+<FLD (2,NO%COL)>!^D10] ;FILL WITH ZEROES,2 COLS WIDE,BASE 10
NOUT ;AND OUTPUT
ERJMP [JSP T4,ERROUT ;GET ERRMSG AND RETURN
RET]
MOVEI T2,":" ;OUTPUT ANOTHER SEPERATOR
BOUT ;AND OUTPUT IT
POP P,T2 ;RETRIEVE THE REMAINDER (SECONDS)
NOUT ;AND OUTPUT IT
ERJMP [JSP T4,ERROUT ;GET ERRMSG AND RETURN
RET]
RET ;NORMAL RETURN
SUBTTL ERROUT - GET THE LAST JSYS ERROR CODE AND RETURN
;ACCEPTS:
;RETURNS: +1,ALWAYS T2/PROCESS HANDLE,,ERROR CODE
ERROUT: MOVEI T1,.FHSLF
GETER
RET
IFN TSTFLG,<
PDL: BLOCK PDLEN ;PUSH DOWN POINTER
>
IPCOML=20 ;LENGTH OF IPCF COMMUNCATION BLOCK
IPCOM: BLOCK IPCOML ;COMMUNICATION BLOCK
BLOCK 12 ;THIS SPACE MUST BE AFTER IPCOM
OURPID: BLOCK 1 ;HOLD AREA FOR OUR PID
SYSPID: BLOCK 1 ;HOLD AREA FOR <SYSTEM>INFO PID
PDBLEN=6 ;LENGTH OF PDB BLOCKS
SYSPDB: BLOCK PDBLEN ;SYSTEM PACKET DESCRIPTOR BLOCK
PDB: BLOCK PDBLEN ;REGULAR PACKET DESCRIPTOR BLOCK
UETPID: BLOCK 1 ;PID FOR "UETP-..."
;
; THIS NEXT SECTION MUST REMAIN IN IT'S CURRENT ORDER. EACH ITEM IS
; A FIELD IN A LARGER RECORD.
;
BASERC::
DEFTYP: ASCII/ / ;DEFAULT MESSAGE TYPE VALUE
TNAME: ASCII/ / ;DEFAULT TEST NAME
DATE: ASCII/ / ;DATE OF RECORD
TIME: ASCII/ / ;TIME OF MESSAGE
TDEPTH: ASCII/ / ;DEPTH OF TEST
TSTLBL: ASCII/ / ;DEFAULT TEST LABEL
CPUTIM: ASCII/ / ;CPU TIME USED IN THIS JOB
CNSTIM: ASCII/ / ;TOTAL CONSOLE TIME (ELAPSED TIME)
BLOCK 1 ;SPACER FOR TOKENIZING
MESVER: EXP 2 ;Message version
BASESZ=.-BASERC ;SIZE OF BASE RECORD
RECLEN=1000-<.-BASERC> ;RECORD LENGTH
MSGREC: BLOCK RECLEN ;AREA FOR EXTRACTED RECORD
;
; END OF ORDERED SECTION FOR OUTPUT RECORDS
;
RELOC .!777+1-140
IPCFPG: BLOCK 1000
DUMMY: EXP 0
IFN TSTFLG,<
END START
>
;
;[END OF UETP-TALK.MAC]
;
SUBTTL MACRO DEFINITIONS
COMMENT $
DEFINE A MACRO TO GENERATE A COMND FUNCTION DESCRIPTOR BLOCK WITH
AN EXTRA WORD AT BLOCK-1 TO USE FOR FINDING NEXT FUNCTION DESCRIPTOR
BLOCK LIST
THIS BLOCK IS TO BE CALLED A PARSER DESCRIPTOR BLOCK (PDB)
$
; !=======================================================!
; ! FUNCTION ! FUNCTION ! ADDRESS OF NEXT FUNCTION !
; ! CODE ! FLAGS ! DESCRIPTOR BLOCK !
; !-------------------------------------------------------!
; ! DATA FOR SPECIFIC FUNCTION !
; !-------------------------------------------------------!
; ! POINTER TO HELP TEXT FOR FIELD !
; !-------------------------------------------------------!
; ! POINTER TO DEFAULT STRING FOR FIELD !
; +-------------------------------------------------------+
; ! SPECIAL ACTION ROUTINE FOR THIS PDB !
; !-------------------------------------------------------!
; ! PDB DEFAULT FILLING ROUTINE !
; !-------------------------------------------------------!
; ! ERROR ROUTINE !
; !-------------------------------------------------------!
; ! CHAIN POINTER TO LINKED PDB'S !
; !=======================================================!
COMMENT \
ARGUMENTS TO THE PDBDEF MACRO ARE:
TYP TYPE OF FDB, IE. .CMKEY
FLGS FUNCTION SPECIFIC FLAGS
DATA FUNCTION SPECIFIC DATA
HLPM BYTE POINTER FOR HELP TEXT
DEFM POINTER TO DEFAULT
LST POINTER TO ALTERNATE FDB
NXT PTR TO NEXT FDB (OPTIONAL FOR TYPE .CMKEY OR .CMSWI)
ERRTN ROUTINE IF AN ERROR IS GOTTEN POINTING TO THIS PDB
RTN SPECIAL ACTION ROUTINE FOR THIS PDB
DEFR SPECIAL ROUTINE TO FILL IN DEFAULTS FOR THIS PDB
\
DEFINE PDBDEF(TYP,FLGS,DATA,HLPM,DEFM,LST,NXT,ERRTN,RTN,DEFR),<
XLIST
;THE NEXT FEW LINES ARE COPIED FROM MONSYM FOR THE FLDDB. MACRO
..XX==<FLD(TYP,CM%FNC)>+FLGS+<Z LST>
IFNB <HLPM>,<..XX=..XX+CM%HPP>
IFNB <DEFM>,<..XX=..XX+CM%DPP>
..XX
IFNB <DATA>,<DATA>
IFB <DATA>,<0>
IFNB <HLPM>,<POINT 7,[ASCIZ \HLPM\]>
IFB <HLPM>,<0>
IFNB <DEFM>,<POINT 7,[ASCIZ \DEFM\]>
IFB <DEFM>,<0>
;THE REST OF THE DEFINITION IS NOT USED BY THE JSYS BUT ONLY BY THE PARSER
IFB <RTN>,<0>
IFNB <RTN>,<Z RTN>
IFB <DEFR>,<0>
IFNB <DEFR>,<Z DEFR>
IFB <ERRTN>,<0>
IFNB <ERRTN>,<Z ERRTN>
IFB <NXT>,<0>
IFNB<NXT><Z NXT>
LIST
>;END OF DEFINITION OF PDBDEF MACRO
SUBTTL PDB -- PARSER DESCRIPTOR BLOCK
;THIS BLOCK IS DEFINED BY THE PDBDEF MACRO
;THE SYMBOLS HERE ARE FOR REFERENCING IT
PHASE 0
PDB.FD:! BLOCK .CMDEF+1 ;ALLOCATE SPACE FOR AN FDB
PDB.RT:! BLOCK 1 ;SPECIAL ACTION ROUTINE ADDRESS
PDB.DF:! BLOCK 1 ;DEFAULT FILLING ROUTINE ADDRESS
PDB.ER:! BLOCK 1 ;ERROR MESSAGE ROUTINE ADDRESS
PDB.NX:! BLOCK 1 ;ADDRESS OF PDB TO USE NEXT
PDB.SZ:! ;SIZE OF A PDB
DEPHASE
SUBTTL COMMAND FUNCTION MACROS
DEFINE $KEYDSP (TABLE) <
PDBDEF (.CMKEY,,TABLE)>
DEFINE $KEY (NXT,TABLE) <
PDBDEF (.CMKEY,,TABLE,,,,NXT)>
DEFINE $NUMBER (NXT,RADIX,HELP) <
IFB <HELP>,<PDBDEF (.CMNUM,,RADIX,,,,NXT)>
IFNB <HELP>,<PDBDEF (.CMNUM,CM%SDH,RADIX,<HELP>,,,NXT)>>
DEFINE $NOISE (NXT,TEXT) <
PDBDEF (.CMNOI,,<POINT 7,[ASCIZ/TEXT/]>,,,,NXT)>
DEFINE $SWITCH (NXT,TABLE) <
PDBDEF (.CMSWI,,TABLE,,,,,NXT)>
DEFINE $IFILE (NXT,HELP) <
IFB <HELP>,<PDBDEF (.CMIFI,,,,,,NXT)>
IFNB <HELP>,<PDBDEF (.CMIFI,CM%SDH,,<HELP>,,,NXT)>>
DEFINE $OFILE (NXT,HELP) <
IFB <HELP>,<PDBDEF (.CMOFI,,,,,,NXT)>
IFNB <HELP>,<PDBDEF (.CMOFI,CM%SDH,,<HELP>,,,NXT)>>
DEFINE $FIELD (NXT,HELP) <
IFB <HELP>,<PDBDEF (.CMFLD,,,,,,NXT)>
IFNB <HELP>,<PDBDEF (.CMFLD,CM%SDH,,<HELP>,,,NXT)>>
DEFINE $CRLF <
PDBDEF (.CMCFM)>
DEFINE $DIR (NXT) <
PDBDEF (.CMDIR,,,,,,NXT)>
DEFINE $USER (NXT) <
PDBDEF (.CMUSR,,,,,,NXT)>
DEFINE $COMMA (NXT) <
PDBDEF (.CMCMA,,,,,,NXT)>
DEFINE $INIT (NXT) <
PDBDEF (.CMINI,,,,,,NXT)>
DEFINE $FLOAT (NXT,HELP) <
IFB <HELP>,<PDBDEF (.CMFLT,,,,,,NXT)>
IFNB <HELP>,<PDBDEF (.CMFLT,CM%SDH,,<HELP>,,,NXT)>>
DEFINE $DEV (NXT) <
PDBDEF (.CMDEV,,,,,,NXT)>
DEFINE $TEXT (NXT,HELP) <
IFB <HELP>,<PDBDEF (.CMTXT,,,,,,NXT)>
IFNB <HELP>,<PDBDEF (.CMTXT,CM%SDH,,<HELP>,,,NXT)>>
DEFINE $DATE (NXT) <
PDBDEF (.CMTAD,,CM%IDA,,,,NXT)>
DEFINE $TIME (NXT) <
PDBDEF (.CMTAD,,CM%ITM,,,,NXT)>
DEFINE $TAD (NXT) <
PDBDEF (.CMTAD,,<CM%IDA!CM%ITM>,,,,NXT)>
DEFINE $QUOTE (NXT,HELP) <
IFB <HELP>,<PDBDEF (.CMQST,,,,,,NXT)>
IFNB <HELP>,<PDBDEF (.CMQST,CM%SDH,,<HELP>,,,NXT)>>
DEFINE $TOKEN (NXT,CHAR) <
PDBDEF (.CMTOK,,<CHAR>,,,,NXT)>
DEFINE DSPTAB (NXT,CODE,KEY) <
XWD [ASCIZ\KEY\],[XWD CODE,NXT]>
DEFINE KEYTAB (CODE,KEY) <
XWD [ASCIZ\KEY\],CODE>
DEFINE $STAB (%X,%Y) <
%X==.
XWD %Y-1,%Y-1
DEFINE $ETAB <
%Y==.-%X>>
;PARSE DEFINITIONS
;DEFSTR DEFINITIONS
MSKSTR (CMFNC,.CMFNP,CM%FNC) ;COMMAND FUNCTION CODE
MSKSTR (CMLST,.CMFNP,CM%LST) ;ADR OF FUNCTION DESCRIPTOR BLOCK
DEFSTR (CMDAT,.CMDAT,35,36) ;COMMAND DATA
DEFSTR (PDBER,PDB.ER,35,36) ;ERROR MESSAGE ROUTINE ADDRESS
DEFSTR (PDBNX,PDB.NX,35,36) ;ADR OF NEXT PDB
DEFSTR (PDBDF,PDB.DF,35,36) ;ADR OF DEFAULT FILLING ROUTINE
SUBTTL Constant Definitions
NCHPW==5 ;NUMBER OF ASCII CHARACTERS PER WORD
BUFSIZ==200 ;SIZE OF INPUT TEXT BUFFER
ATMSIZ==BUFSIZ ;SIZE OF ATOM BUFFER FOR COMND JSYS
GJFSIZ==.GJRTY+2 ;SIZE OF GTJFN BLOCK USED BY COMND JSYS
FDBSIZ==.CMDEF+2 ;SIZE OF FUNCTION DESCRIPTOR BLOCK
SUBTTL Local Storage
;STORAGE FOR PARSER TO EVENT PROCESSOR COMMUNICATION
ZERBEG==. ;START OF AREA TO BE ZEROED
PARFRE: BLOCK 1 ;POINTER TO FIRST FREE IN COMM BLOCK
ARGFRE: BLOCK 1 ;POINTER TO FIRST FREE WORD IN ARG SPACE
JFNFRE: BLOCK 1 ;IOWD POINTER TO JFN STACK
JFNSTL==40 ;LENGTH OF JFNSTK
JFNSTK: BLOCK JFNSTL ;LIST OF ALL STACKED JFNS
PARBLK: BLOCK 50 ;SPACE FOR COMM BLOCK
ARGBLK: BLOCK 400 ;SPACE FOR ARGUMENTS (ASCIZ, ETC.)
ARGEND==.-1 ;WHERE TO STOP ZEROING
;STORAGE FOR THE PARSER
CMDBLK: BLOCK .CMGJB+5 ;COMMAND STATE BLOCK FOR COMND JSYS
BUFFER: BLOCK BUFSIZ ;INPUT TEXT STORED HERE
ATMBFR: BLOCK ATMSIZ ;ATOM BUFFER FOR COMND JSYS
GJFBLK: BLOCK GJFSIZ ;GTJFN BLOCK FOR COMND JSYS
ZEREND==. ;END OF AREA TO BE ZEROED
SUBTTL Main ROUTINE
;ROUTINE TO PARSE A COMMAND
;ACCEPTS IN T1/ STRING POINTER TO PROMPT
; T2/ POINTER TO THE COMMAND "PDB" CHAIN
; T3/ ADDRESS OF WHERE TO STORE THE PARSED COMMAND
; CALL PARSE
;RETURNS +1: FAILED - COMMAND "PDB" BLOCK DID NOT START WITH A .CMINI
; +2: OK, PARSED COMMAND IS STORED IN BLOCK GIVEN IN T3
; T1/ POINTER TO THE COMMAND STRING
PARSE:: SAVEPQ ;SAVE ALL PERMANENT ACS
STKVAR <PARCMT,PARADR>
MOVEM T2,PARCMT ;SAVE POINTER TO THE COMMAND TABLE
MOVEM T3,PARADR ;SAVE POINTER TO WHERE TO BUILD THE PARAMETER BLOCK
LOAD T4,CMFNC,(T2) ;GET THE FIRST FUNCTION CODE
CAIE T4,.CMINI ;IT MUST BE AN INI FUNCTION
RET ;IF NOT, THEN GIVE ERROR RETURN
;NOW SET UP THE COMMAND STATE BLOCK
MOVE T4,[ZERBEG,,ZERBEG+1]
SETZM ZERBEG ;FIRST ZERO ALL STORAGE USED
BLT T4,ZEREND-1
MOVEM T1,CMDBLK+.CMRTY ;PUT RE-TYPE PROMPT POINTER IN STATE BLOCK
HRROI T1,BUFFER ;GET POINTER TO INPUT TEXT BUFFER
MOVEM T1,CMDBLK+.CMPTR ;SAVE POINTER TO COMMAND STRING
MOVEM T1,CMDBLK+.CMBFP ;SAVE POINTER TO START-OF-BUFFER
MOVE T1,[.PRIIN,,.PRIOU] ;GET PRIMARY INPUT,, OUTPUT JFN'S
MOVEM T1,CMDBLK+.CMIOJ ;SAVE PRIMARY JFN'S
MOVEI T1,REPARS ;GET RE-PARSE ADDRESS
MOVEM T1,CMDBLK+.CMFLG ;SAVE RE-PARSE ADDRESS
SETZM CMDBLK+.CMINC ;INITIALIZE # OF CHARACTERS AFTER POINTER
MOVEI T1,BUFSIZ*NCHPW ;GET # OF CHARACTERS IN BUFFER AREA
MOVEM T1,CMDBLK+.CMCNT ;SAVE INITIAL # OF FREE CHARACTER POSITIONS
HRROI T1,ATMBFR ;GET POINTER TO ATOM BUFFER
MOVEM T1,CMDBLK+.CMABP ;SAVE POINTER TO LAST ATOM INPUT
MOVEI T1,ATMSIZ*NCHPW ;GET # OF CHARACTERS IN ATOM BUFFER
MOVEM T1,CMDBLK+.CMABC ;SAVE COUNT OF SPACE LEFT IN ATOM BUFFER
MOVEI T1,GJFBLK ;GET ADDRESS OF GTJFN BLOCK
MOVEM T1,CMDBLK+.CMGJB ;SAVE IN COMMAND STATE BLOCK
MOVE T1,[IOWD JFNSTL,JFNSTK]
MOVEM T1,JFNFRE ;SET UP POINTER TO JFN STACK
PARSER: MOVEI P1,CMDBLK ;COMND STATE BLOCK
MOVE P2,PARCMT ;INITIAL PDB TO FEED TO COMND
CALL RELJFN ;RELEASE ALL JFNS ON THE STACK
PARS.1: DMOVE T1,P1 ;COPY THE COMND ARGS
COMND ;PARSE NEXT FIELD
ERJMP CMDERR ;ERROR, SEE WHY
TXNN T1,CM%NOP ;VALID COMMAND ENTERED ?
JRST PARS.3 ;YES, GO DISPATCH TO PROCESSING ROUTINE
LOAD P2,PDBER,(P2) ;GET ADDR OF SPECIAL ERROR ROUTINE
JUMPE P2,PARS.2 ;IF NO ROUTINE JUST TYPE COMMAND ERROR
CALL (P2) ;CALL THE ROUTINE
JRST PARSER ;GO TRY TO GET A COMMAND AGAIN
PARS.2: HRROI T1,[ASCIZ/
?COMMAND ERROR: /]
PSOUT
MOVX T1,.PRIOU ;TO PRIMARY OUTPUT
MOVE T2,[.FHSLF,,-1] ;OUR LAST ERROR
ERSTR ;TYPE OUT THE ERROR STRING
JRST [ CALL ERRUEN ;UNDEFINED ERROR NUMBER
JRST PARSER]
JRST [ CALL ERRBDD ;BAD DESTINATION DESIGNATOR
JRST PARSER]
JRST PARSER ;AND TRY AGAIN
;HERE ON SUCCESSFUL PARSE FROM COMMAND JSYS
PARS.3: MOVE P2,T2 ;COPY DATA TO P2
MOVE P4,T3 ;SAVE POINTER TO FUNCTION BLOCK
LOAD P3,CMFNC,(P4) ;GET THE COMMAND FUNCTION CODE
MOVE T1,P3 ;COPY FUNCTION TO T1
MOVE T2,P2 ;AND DATA TO T2
CALL @PARTAB(T1) ;DISPATCH OFF FUNCTION
MOVE T1,P3 ;COPY FUNCTION TO T1
MOVE T2,P2 ;AND DATA TO T2
SKIPE T4,PDB.RT(P4) ;GET SPECIAL ROUTINE ADDRESS FROM PDB
CALL (T4) ;CALL THE SPECIAL ROUTINE IF THERE
HRRZ P2,(P2) ;GET CONTENTS OF RETURNED DATA
LOAD T1,PDBNX,(P4) ;GET NEXT FDB IF ANY
JUMPN T1,PARS.4 ;USE IT IF ONE IS SPECIFIED
CAIE P3,.CMKEY ;KEYWORD
CAIN P3,.CMSWI ;OR SWITCH ?
SKIPA T1,(P2) ;YES, USE DATA IN KEYTAB AS FDB ADR
LOAD T1,PDBNX,(P4) ;NO, GET NEXT FDB FROM CURRENT
JUMPE T1,PARS.5 ;IF NO NEXT PDB, GO BUILD ANSWER
PARS.4: HRRZS P2,T1 ;PASS ONLY RIGHT HALF
CALL FILDEF ;GO FILL IN ANY DEFAULTS NEEDED
JRST PARS.1 ;AND FINISH COMMAND
PARS.5: MOVE T1,PARADR ;GET ADR OF WHERE TO BUILD BLOCK
CALL BLDCOM ;GO BUILD A COMMAND MESSAGE
MOVE T1,[POINT 7,BUFFER] ;RETURN POINTER TO THE COMMAND
RETSKP ;DONE
SUBTTL Routine to Take a Parser Block and Build a Command Message
;ROUTINE TO BUILD THE PARSED BLOCK
;ACCEPTS IN T1/ ADR OF WHERE TO PUT THE BUILT BLOCK
; ASSMUES ALL DATA IS SET UP IN AGRBLK
;RETURNS +1: ALWAYS
BLDCOM: SAVEP ;SAVE NEEDED AC'S
MOVE P1,PARFRE ;COMPUTE LENGTH OF
SUBI P1,PARBLK ;PARSER BLOCK
MOVE P2,ARGFRE ;GET END OF ARG SPACE
SUBI P2,ARGBLK ;COMPUTE LENGTH
MOVE P3,P1 ;TAKE COPY OF PARSER BLOCK LENGTH
MOVNS P1 ;MAKE P1 NEGATIVE FOR AOBJN
HRLS P1 ;MAKE AOBJN POINTER
HRRI P1,PARBLK ;POINT TO PARBLK (PARSER DATA BLOCK)
BLDC.1: MOVE T4,(P1) ;GET DATA
HLRZ Q1,T4 ;GET CODE
CAIE Q1,.CMSWI ;SWITCH?
CAIN Q1,.CMKEY ;OR KEYWORD?
JRST BLDC.2 ;YES, NO OFFSET NEEDED
CAIE Q1,.CMCFM ;CONFIRM?
CAIN Q1,.CMCMA ;OR COMMA?
JRST BLDC.2 ;YES, NO OFFSET NEEDED
ADD T4,P3 ;ADD IN OFFSET
BLDC.2: MOVEM T4,(T1) ;COPY TO IPCF PAGE
ADDI T1,1 ;INCREMENT IPCF PAGE POINTER
AOBJN P1,BLDC.1 ;LOOP FOR ALL
MOVNS P2 ;GET NEGATIVE LENGTH OF DATA AREA
HRLZS P2 ;MAKE AN AOBJN POINTER
BLDC.3: MOVE T4,ARGBLK(P2) ;GET CURRENT WORD INTO T4
MOVEM T4,(T1) ;SAVE IN MESSAGE BEING BUILT
ADDI T1,1 ;INCREMENT POINTER TO MESSAGE
AOBJN P2,BLDC.3 ;AND STEP THRU DATA AREA
RET ;AND RETURN
SUBTTL Routine to Set Up for COMND Reparse
;THIS ROUTINE IS GOTTEN TO BY THE COMND JSYS CHANGING THE PC WHEN
;A USER RUBS OUT ACROSS A FIELD. IT JUST CLEARS OUT THE TEMPORARY
;STORAGE USED BY COMND AND RESTARTS THE PARSER
REPARS: CALL RELJFN ;RELEASE ALL JFNS SO FAR
CALL @.CMINI+PARTAB ;TELL SAVE ROUTINES TO FORGET IT
MOVE T1,[GJFBLK,,GJFBLK+1] ;SET UP TO CLEAR GTJFN BLOCK
SETZM GJFBLK ;CLEAR FIRST WORD
BLT T1,GJFBLK+GJFSIZ-1 ;CLEAR THE BLOCK
MOVEI P1,CMDBLK ;GET STATE BLOCK ADDRESS
MOVE P2,PARCMT ;GET INITIAL COMMAND TABLE POINTER
LOAD P2,PDBNX,(P2) ;STEP TO BLOCK AFTER .CMINI
JRST PARS.1 ;JUST RESTART PARSER
;ROUTINE TO RELEASE ALL JFNS STACKED SO FAR
RELJFN: MOVSI T4,JFNSTL ;SET UP AN AOBJN POINTER TO JFN STACK
RELJFL: SKIPE T1,JFNSTK(T4) ;IS THERE A JFN HERE?
RLJFN ;YES, RELEASE IT
JFCL
SETZM JFNSTK(T4) ;ZERO THE STACK
AOBJN T4,RELJFL ;LOOP BACK FOR ALL OF THEM
MOVE T1,[IOWD JFNSTL,JFNSTK]
MOVEM T1,JFNFRE ;INIT STACK POINTER
RET ;DONE
SUBTTL Routine To Fill in Defaults for COMND
;ROUTINE TO FILL IN DEFAULTS IF NEEDED
;CALLED WITH P2 POINTING TO PDB ABOUT TO BE FED TO COMND
;FILLS IN ALL DEFAULTS FOR THE NEXT SET OF LINKED PDB'S
FILDEF: MOVE T1,P2 ;COPY THE PDB ADDRESS
FILD.1: LOAD T2,PDBDF,(T1) ;GET THE ADDR OF THE DEFAULT FILLING ROUTINE
JUMPE T2,FILD.2 ;NONE THERE, LOOK FOR LINKED PDB'S
PUSH P,T1 ;SAVE ADR OF PDB
MOVE T1,P1 ;GET ADR OF COMND STATE BLOCK
CALL (T2) ;CALL THE DEFAULT FILLER
POP P,T1
FILD.2: LOAD T1,CMLST,(T1) ;GET THE ADDR OF NEXT PDB IN LIST
JUMPN T1,FILD.1 ;LOOP IF THERE IS ONE
RET ;AND RETURN
;CMDERR - ROUTINE TO PROCESS ERRORS ON EXECUTING A COMND JSYS
; IF END OF FILE REACHED ON A TAKE FILE, THE NEXT COMMAND
; IS SIMPLY PROCESSED. ELSE AN ERROR MESSAGE IS ISSUED AND
; THE PROGRAM IS RESTARTED.
;
;CALL: JRST CMDERR
CMDERR: HRROI T1,[ASCIZ/
?COMMAND ERROR: /]
PSOUT
MOVX T1,.PRIOU ;TO PRIMARY OUTPUT
MOVE T2,[.FHSLF,,-1] ;OUR LAST ERROR
ERSTR ;TYPE OUT THE ERROR STRING
JRST [ CALL ERRUEN ;UNDEFINED ERROR NUMBER
JRST PARSER]
JRST [ CALL ERRBDD ;BAD DESTINATION DESIGNATOR
JRST PARSER]
JRST PARSER ;GO START OVER AGAIN
SUBTTL ERROR ROUTINES
BADCOM:: HRROI T1,[ASCIZ/
?INVALID COMMAND "/]
PSOUT
HRROI T1,ATMBFR
PSOUT
HRROI T1,[ASCIZ/" /]
PSOUT
RET
BADIFI:: MOVX T1,GJ%OFG ;PARSE-ONLY GTJFN
MOVEM T1,GJFBLK+.GJGEN ;IN FLAGS WORD
MOVE T1,[XWD .NULIO,.NULIO] ;SUPPLY NO JFNS
MOVEM T1,GJFBLK+.GJSRC ;INTO BLOCK
MOVEI T1,GJFBLK ;GTJFN BLOCK ADDRESS
HRROI T2,ATMBFR ;STRING POINTER TO ATOM BUFFER
GTJFN ;GET A JFN
JRST BADI.1 ;JUST DO THE ERSTR
HRROI T1,[ASCIZ/
?CAN'T FIND FILE "/]
PSOUT
HRRZ T2,T1 ;MOVE JFN TO T2 FOR JFNS
MOVEI T1,.PRIOU ;TO PRIMARY OUTPUT
MOVE T3,[111100,,1] ;GET OUT EVERYTHING UP TO THE PROTECTION
JFNS ;MAKE THE JFN INTO A STRING
HRROI T1,[ASCIZ/"
/]
PSOUT
BADI.1: MOVX T1,.PRIOU ;TO PRIMARY OUTPUT
MOVE T2,[.FHSLF,,-1] ;OUR LAST ERROR
ERSTR ;TYPE OUT THE ERROR STRING
CALLRET ERRUEN ;UNDEFINED ERROR NUMBER
CALLRET ERRBDD ;BAD DESTINATION DESIGNATOR
RET
;ERSTR JSYS FAILURE ROUTINES
ERRBDD: SKIPA T1,[-1,,[ASCIZ/ERSTR Jsys Failure, Bad Destination Designator/]]
ERRUEN: HRROI T1,[ASCIZ/ERSTR Jsys Failure, Undefined Error Number/]
PSOUT
RET
SUBTTL Dispatch for Parser Save Routines
COMMENT \
THE ROUTINES ON THE NEXT FEW PAGES SAVE THE OUTPUT OF THE PARSER IN
A FORM USABLE BY THE EVENT PROCESSOR. THE ACTUAL DATA STRUCTURE IS
DOCUMENTED IN PARSER.RNO
\
;THIS IS THE DISPATCH TABLE FOR THE VARIOUS SAVE ROUTINES, ONE FOR
;EACH TYPE OF FIELD THE COMND JSYS CAN PARSE. THESE ROUTINES ARE CALLED
;ON EACH SUCCESSFUL RETURN FROM THE COMND JSYS
;ALL THESE ROUTINES ARE CALLED WITH T1 CONTAINING THE COMND FUNCTION CODE
;USED TO PARSE THE LAST FIELD AND T2 CONTAINING THE DATA RETURNED BY COMND
;T3 MUST CONTAIN THE ADDRESS OF THE FDB USED BY COMND TO PARSE THE FIELD
PARTAB: SAVIND ;KEYWORD (.CMKEY)
SAVNUM ;NUMBER (.CMNUM)
R ;NOISE WORD (.CMNOI) (NO PROCESSING)
SAVIND ;SWITCH (.CMSWI)
SAVJFN ;INPUT FILE SPEC (.CMIFI)
SAVJFN ;OUTPUT FILE SPEC (.CMOFI)
SAVJFN ;GENERAL FILE SPEC (.CMFIL)
SAVATM ;ARBITRARY FIELD (.CMFLD)
SAVZER ;CONFIRM (.CMCFM)
SAVRSS ;DIRECTORY (.CMDIR)
SAVRSS ;USER NAME (.CMUSR)
SAVZER ;COMMA (.CMCMA)
SAVINI ;INITIALIZATION (.CMINI)
;THIS IS CALLED TO INITIALIZE SAVE STUFF
SAVRES ;FLOATING POINT NUMBER (.CMFLT)
SAVRES ;DEVICE NAME (.CMDEV)
SAVATM ;TEXT TO CARRAIGE RETURN (.CMTXT)
SAVRES ;DATE AND TIME (.CMTAD)
SAVATM ;QUOTED STRING (.CMQST)
R ;***RET FOR NOW***;UNQUOTED STRING (.CMUQS)
SAVTOK ;TOKEN (.CMTOK)
SAVNUM ;NUMBER (ARBITRARY TERMINATOR) (.CMNUX)
R ;(.CMACT)
SAVATM ;NODE NAME(.CMNOD)
SUBTTL Save Routines
;DATA RETURNED IS A POINTER INTO A TABLE (SWITCH OR KEYWORD)
SAVIND: HRRZ T2,(T2) ;GET INDIRECT ADDRESS
LOAD T4,PDBNX,(T3) ;GET THE NEXT FDB FROM THIS ONE
SKIPN T4 ;IF ONE THERE, STORE ADDRESS INSTEAD
HLRZ T2,(T2) ;FETCH CODE SET UP BY KEYTAB MACRO
JRST MAKENT ;AND MAKE THE ENTRY
;SAVE ROUTINES FOR FUNCTIONS WHICH COPY VALUE TO ATOM BUFFER
;(.CMFLD, .CMTXT, .CMQST)
SAVATM: SAVEP ;SAVE NEEDED REGS
MOVE T2,ARGFRE ;GET FIRST FREE ARG LOCATION
HRLI T2,(POINT 7,) ;MAKE T2 A BYTE POINTER
MOVE P1,[POINT 7,ATMBFR] ;POINT AT THE ATOM BUFFER
SAVA.1: ILDB P2,P1 ;GET A CHARACTER FROM THE ATOM BUFFER
IDPB P2,T2 ;SAVE IT IN THE ARGUMENT SPACE
JUMPN P2,SAVA.1 ;AND LOOP IF MORE
HRRZI T2,1(T2) ;STEP TO NEXT LOC AND CLEAR LH
EXCH T2,ARGFRE ;STORE NEXT FREE AND GET FIRST USED
SUBI T2,ARGBLK ;CONVERT TO RELATIVE ADDRESS
JRST MAKENT ;AND MAKE THE ENTRY
;SAVE A ZERO (CONFIRM OR COMMA, FUNCTION TELLS ALL)
SAVZER: SETZ T2, ;JUST A ZERO
JRST MAKENT ;GO MAKE AN ENTRY
;SAVE ROUTINE FOR NUMBERS
SAVNUM: SAVEP ;SAVE AN AC
LOAD P1,CMDAT,(T3) ;GET THE RADIX USED
DPB P1,[POINT 9,T1,26] ;SAVE IT WITH FUNCTION
;AND FALL INTO SAVRES
;ROUTINE TO STACK A JFN
SAVJFN: MOVE T4,JFNFRE ;GET POINTER TO JFN STACK
PUSH T4,T2 ;STACK THE JFN
MOVEM T4,JFNFRE ;STORE THE UPDATED STACK POINTER
JRST SAVRES ;GO SAVE THE JFN IN THE ANSWER BLOCK
;SAVE ROUTINES WHICH SAVE A POINTER TO WHAT COMND RETURNS IN AC2
;(FLOATING NUMBER, DATE/TIME, DEVICE, FILE SPECS)
SAVRES: SAVEP ;SAVE A WORKING REG
MOVE P1,ARGFRE ;GET THE NEXT FREE ARG BLOCK WORD
MOVEM T2,(P1) ;SAVE THE RESULT OF COMND THERE
MOVE T2,P1 ;GET ADDR USED INTO T2
SUBI T2,ARGBLK ;MAKE IT THE OFFSET INTO ARGBLK
AOS ARGFRE ;STEP FREE LOC UP ONE
JRST MAKENT ;AND GO MAKE THE ENTRY
;ROUTINE TO SAVE ANSWER AND ATOM BUFFER
;(USER, DIRECTORY)
SAVRSS: SAVEP ;SAVE A WORKING REG
MOVE P1,ARGFRE ;GET THE NEXT FREE ARG BLOCK WORD
MOVEM T2,(P1) ;SAVE THE RESULT OF COMND THERE
AOS T2,ARGFRE ;STEP FREE LOC UP ONE
HRLI T2,(POINT 7,) ;MAKE T2 A BYTE POINTER
MOVE P1,[POINT 7,ATMBFR] ;POINT AT THE ATOM BUFFER
SAVR.1: ILDB P2,P1 ;GET A CHARACTER FROM THE ATOM BUFFER
IDPB P2,T2 ;SAVE IT IN THE ARGUMENT SPACE
JUMPN P2,SAVR.1 ;AND LOOP IF MORE
HRRZI T2,1(T2) ;STEP TO NEXT LOC AND CLEAR LH
EXCH T2,ARGFRE ;STORE NEXT FREE AND GET FIRST USED
SUBI T2,ARGBLK+1 ;CONVERT TO RELATIVE ADDRESS
JRST MAKENT ;AND MAKE THE ENTRY
;SAVE A TOKEN
SAVTOK: SAVEP ;SAVE SOME WORKING SPACE
MOVE T2,ARGFRE ;GET SPACE TO STORE ARG TO T2
HRLI T2,(POINT 7,) ;MAKE IT A BYTE POINTER
LOAD P2,CMDAT,+PDB.FD(T2) ;GET THE DATA USED BY COMND
HRLI P2,(POINT 7,) ;MAKE IT A BYTE POINTER
SAVT.1: ILDB P1,P2 ;GET A CHARACTER
IDPB P1,T2 ;AND SAVE IT AWAY
JUMPN P1,SAVT.1 ;LOOP IF NOT DONE
HRRZI T2,1(T2) ;POINT T2 TO FIRST FREE LOC
EXCH T2,ARGFRE ;AND CHANGE IT WITH FIRST USED
SUBI T2,ARGBLK ;CONVERT TO RELATIVE ADDRESS
JRST MAKENT ;AND GO MAKE ENTRY
SUBTTL Initialization for Parser Save Routines
;THIS ROUTINE IS CALLED TO INITIALIZE THE SAVE ROUTINES FOR THE PARSER
;IT IS THE FUNCTION DEPENDENT ROUTINE FOR THE .CMINI FUNCTION
SAVINI: MOVEI T1,ARGBLK ;GET THE ADDRESS OF THE ARGUMENT STORAGE
MOVEM T1,ARGFRE ;SAVE AS FIRST FREE PLACE TO SAVE STUFF
MOVEI T1,PARBLK ;GET ADDRESS OF PARSER COMMUNICATIONS BLOCK
MOVEM T1,PARFRE ;SAVE AS FIRST FREE LOC IN THAT BLOCK
MOVE T1,[PARBLK,,PARBLK+1] ;GET START OF BLOCK TO CLEAR
SETZM (T1) ;CLEAR FIRST WORD
BLT T1,ARGEND ;CLEAR TO END OF ARGUMENT SPACE
RET ;AND RETURN
SUBTTL MAKENT -- Routine To Make an Entry for Parser Save Routines
;THIS ROUTINE IS CALLED WITH T2 CONTAINING WHAT WILL BE THE RIGHT HALF
;OF THE ENTRY AND T1 CONTAINING THE LEFT HALF.
MAKENT: HRRZM T2,@PARFRE ;SAVE THE RIGHT HALF
HRLM T1,@PARFRE ;SAVE THE LEFT HALF
AOS PARFRE ;UPDATE THE FREE POINTER
RET ;RETURN
;SUPPORT ROUTINES
SAVPQ: PUSH P,Q1
PUSH P,Q2
PUSH P,Q3
PUSH P,P1
PUSH P,P2
PUSH P,P3
PUSH P,P4
PUSH P,P5
PUSH P,P6
CALL 0(CX)
SKIPA
AOS -11(P)
POP P,P6
POP P,P5
POP P,P4
POP P,P3
POP P,P2
POP P,P1
POP P,Q3
POP P,Q2
POP P,Q1
RET
SAVP: PUSH P,P1
PUSH P,P2
PUSH P,P3
PUSH P,P4
PUSH P,P5
PUSH P,P6
CALL 0(CX)
SKIPA
AOS -6(P)
POP P,P6
POP P,P5
POP P,P4
POP P,P3
POP P,P2
POP P,P1
RET
;COMMAND TABLE
COMTAB: $INIT (COMTB1)
COMTB1: $KEYDSP (COMTB2)
COMTB2: $STAB
DSPTAB (COMTC1,CONN,<CONNECT>)
DSPTAB (COMTE1,EXITC,<EXIT>)
DSPTAB (COMTU1,UPDATE,<UPDATE>)
DSPTAB (COMTV1,VERIFY,<VERIFY>)
$ETAB
COMTC1: $NOISE (COMTC2,<TO UETP USING NAME>)
COMTC2: $FIELD (COMCR,<NAME WHICH UETP WILL USE TO REFERENCE THIS PROGRAM>)
COMTE1: $NOISE (COMCR,<FROM VERIFY PROGRAM>)
COMTU1: $NOISE (COMTU2,<FILE LIST>)
COMTU2: $IFILE (COMCR)
COMTV1: $NOISE (COMTV2,<FILE LISTS>)
COMTV2: PDBDEF (.CMFIL,,,,,,COMCR,,,SETIFG)
COMCR: $CRLF
;ROUTINE TO SET THE PROPER FLAGS IN THE GTJFN BLOCK
;ACCEPTS IN T1/ ADR OF THE COMND STATE BLOCK
SETIFG: MOVE T1,.CMGJB(T1) ;GET THE ADR OF THE GTJFN BLOCK
MOVX T2,GJ%OLD!GJ%IFG!GJ%FLG
MOVEM T2,.GJGEN(T1) ;STORE THE GTJFN FLAGS
RET ;DONE
;VARIABLES
PDLEN==400
PDL: BLOCK PDLEN
UETPF: 0 ;FLAG TO CAUSE MESSAGES TO GO TO UETP
NAME: BLOCK 2 ;NAME STRING FOR UETP TO USE
USTRNG: BLOCK 100 ;MESSAGE STRING FOR UETP MESSAGES
ANSWER: BLOCK 200 ;ANSWER BLOCK
END <3,,ENTVEC>