.
. EDITING COMMANDS
.
. GET, PUT, LOAD, STORE, COR, LST, REP, BLK
.
.
. (C) Copyright 1972-1978 John Walker
.
. This software is in the public domain
.
AXR$
DEFUNCT$
FANG
.
PURE CODE
.
.
. THE GET COMMAND
.
GETX* LX X5,CDBPC,X8 GET POINTER TO FIRST PARAMETER
LX X5,PBLINK,X5 LINK TO FILE NAME PARAMETER
LA A1,PBVAL,X5 LOAD FDT POINTER
LMJ A2,IOGET BUILD AN I/O FCT FOR THE FILE
LX,U X10,,A0 PUT INPUT FCT ADDRESS IN X10
LA,U A0,1 LOAD BLOCK COUNT TO READ
SA A0,IOCOUNT,X10 SET TO READ BUT ONE BLOCK
LA A0,PBLINK,X5 LOAD LINK TO ADDRESS PARAMETER
JZ A0,GETY SKIP ADDRESS SETUP IF NOT SPECIFIED
LA A0,PBVAL,A0 LOAD ADDRESS FROM USER
SA A0,IODRAD,X10 PUT ADDRESS IN PACKET
LA A0,CDOPTS,X8 LOAD COMMAND OPTIONS
OR,U A0,OPTION('S') TELL INPUT NOT TO FUDGE ADDRESS
SA A1,CDOPTS,X8 UPDATE COMMAND OPTIONS
GETY LMJ A2,INPUT CREATE AN INPUT ACTIVITY
GET IOBB,X10 GET A BLOCK FROM THE READER
SA A1,R7 SAVE THE BLOCK ADDRESS
ON DEBUG
TNZ IBLAST,A1 TRAP FOR READER LEFT HANGING
IERR . STOP IF THIS ISN'T LAST BLOCK FROM READ
OFF DEBUG
LA A0,IOFDT,X10 LOAD FDT ADDRESS
SA A0,IBFDT,A1 SAVE FDT OF SOURCE FILE IN BLOCK
LA A0,IBSTAT,A1 LOAD READ STATUS OF BLOCK
JZ A0,GOTB GOT A BLOCK OF O.K.
JE A0,5,GOTB ALSO IF PARTIAL MASS STORAGE BLOCK
JE A0,4,GOTB OR TAPE ABNORMAL FRAME COUNT
JNE A0,1,NGOTB OTHERWISE, STATUS ERROR PRECLUDES STORE
.
. INFORM USER EOF WAS ENCOUNTERED AND NO BLOCK STORED
.
LA,U A0,IOPKT,X10 LOAD I/O PACKET (STATUS WILL STILL
LMJ X11,IOSEDT BE HERE FROM INPUT)
NGOTB BRELP R7 RELEASE THE BLOCK BUFFER
BRELP X10 RELEASE THE I/O FCT
COMPLETE . COMPLETE THE COMMAND
.
. STORE THE BLOCK ON THE INTERNAL BLOCK FDT
.
GOTB LX X5,CDBPC,X8 LOAD FIRST PARAMETER ADDRESS
LX X5,PBVAL,X5 LOAD POINTER TO BLOCK FDT
LMJ A2,BLSTORE UPDATE BLOCK ATTACHMENT
J NGOTB FINISH UP COMMAND
/.
.
. THE PUT COMMAND
.
PUTX* LX X5,CDBPC,X8 LOAD PARAMETER POINTER
LA A14,CDOPTS,X8 LOAD COMMAND OPTIONS
LX X5,PBLINK,X5 LINK TO FILE PARAMETER
LA A1,PBVAL,X5 GET FDT ADDRESS
LMJ A2,IOGET BUILD AN I/O FCT FOR WRITING
LX,U X9,,A0 GET OUTPUT FCT ADDRESS IN X9
LMJ A2,IOGNF BUILD A FAKE FCT
LX,U X10,,A0 USE AS INPUT FCT
LX X5,CDBPC,X8 LOAD PARAMETER CHAIN ADDRESS
LX X5,PBVAL,X5 LOAD ADDRESS OF BLOCK FDT FOR SOURCE
LMJ A2,BLLOAD GET A BLOCK BUFFER
JZ A1,PUTXER ERROR IF NO BLOCK STORED
TZ IOMASS,X9 IS OUTPUT FILE MASS STORAGE ?
TEP,U A14,OPTION('Q') YES. IS 'Q' OPTION ON ?
J NOSOD YES. WRITE AT NEXT SEQUENTIAL BLOCK
LA,U A0,'D' LOAD DUPLICATE ADDRESS MODE
SA A0,IOOPT,X9 SET DUPLICATE ADDRESS OPTION
NOSOD LX X5,CDBPC,X8 LOAD FIRST PARAMETER ADDRESS
LX X5,PBLINK,X5 LINK TO SECOND PARAMETER
LA A0,PBLINK,X5 LOAD LINK TO THIRD PARAMETER
JZ A0,NOADS ANY ADDRESS SPECIFIED ?
LA A0,PBVAL,A0 YES. LOAD ADDRESS FROM PARAMETER
SA A0,IBMSAD,A1 SET BLOCK SOURCE ADDRESS
LA A3,CDOPTS,X8 LOAD COMMAND OPTIONS
OR,U A3,OPTION('S') SET IMPLIED 'S' OPTION
SA A4,CDOPTS,X8 UPDATE OPTIONS IN PACKET
LA,U A3,'D' LOAD THE DUPLICATE ADDRESS OPTION
TZ IOMASS,X9 IS OUTPUT MASS STORAGE ?
SA A3,IOOPT,X9 YES. SET DUPLICATE ADDRESS
NOADS SNONZ IBLAST,A1 SET THIS AS LAST BLOCK
PUT IOBB,X10 FIRE UP WRITER
LMJ A2,OUTPUT CREATE A WRITER ACTIVITY
P IOBB+QL,X9 WAIT FOR WRITE TO FINISH
PUXON BRELP X9 RELEASE OUTPUT FCT
BRELP X10 RELEASE INPUT FCT
COMPLETE . DONE WITH THIS COMMAND
.
PUTXER R$DIT . START UP EDITOR
E$MSG NOBAL EDIT MESSAGE FOR NO BLOCK STORED
LA A0,IOFDT,X9 LOAD OUTPUT FDT ADDRESS
LMJ X11,FIST EDIT FILE AND STATEMENT
ZAP . ROADBLOCK THE FILE
J PUXON RELEASE BUFFERS, RETURN
/.
.
. THE LST COMMAND
.
LSTX* LA,U A8 CLEAR START WORD
LA,U A9,0377777 LOAD ASSUMED WORD COUNT
LX X5,CDBPC,X8 LOAD POINTER TO FIRST PARAMETER
LA A0,PBTYPE,X5 LOAD TYPE OF THE PARAMETER
JNE A0,NUMBER,GETXFL HANDLE MISSING START, END
LA A8,PBVAL,X5 LOAD STARTING WORD
LA,U A9,1 LOAD ASSUMED COUNT FOR START SPECIFIED
LX X5,PBLINK,X5 LINK TO NEXT PARAMETER
LA A0,PBTYPE,X5 LOAD TYPE OF SECOND PARAMETER
JNE A0,NUMBER,GETXFL SKIP IF THIS IS THE BLOCK
LA A9,PBVAL,X5 LOAD LAST WORD PARAMETER
LX X5,PBLINK,X5 LINK TO BLOCK PARAMETER
GETXFL LX X5,PBVAL,X5 LOAD POINTER TO FDT
AA A9,A8 COMPUTE LAST WORD + 1
ANA,U A9,1 COMPUTE LAST WORD TO DUMP
LMJ A2,BLLOAD GET A BLOCK COPY
JZ A1,NBS SKIP IF NO BLOCK STORED
LA A0,IBLEN,A1 LOAD LENGTH OF BLOCK
ANA,U A0,1 COMPUTE LAST WORD NUMBER
TLE A0,A9 DOES LAST WORD RUN OFF END ?
LA,U A9,,A0 LOAD ACTUAL LAST WORD
TLE A0,A8 IS IT POSSIBLE TO DUMP ANYTHING
J TOOSHRT YES. GIVE A MESSAGE
LA A0,A9 LOAD LAST WORD
ANA A0,A8 COMPUTE LENGTH TO DUMP
AA,U A0,1 GET ACTUAL WORD COUNT
SA A0,IBLEN,A1 PUT LENGTH IN BLOCK
JZ A8,NUGATORY SKIP MOVE IF NOT NEEDED
LA A2,A8 LOAD START WORD
AA,U A2,IBDATA,A1 COMPUTE START ADDRESS
LXI,U A2,1 SET UP INCREMENT
LR R1,IBLEN,A1 LOAD LENGTH TO MOVE
LA,U A3,IBDATA,A1 LOAD ADDRESS OF BUFFER START
LXI,U A3,1 SET UP INCREMENT
BT A3,,*A2 SHIFT BLOCK TO START
NUGATORY SA A1,A8 SAVE BLOCK ADDRESS
LMJ A2,IOGNF BUILD A FCT
LX,U X10,,A0 GET FCT ADDRESS IN X10
P PRINTER ACQUIRE THE PRINTER
LX,U X9,PRINTX GET COMPLETION QUEUE
LMJ A2,PRINT CREATE A PRINT ACTIVITY
LA A1,A8 GET THE BUFFER ADDRESS
LA A2,IBFDT,A1 LOAD THE FDT SOURCE ADDRESS
SA A2,IOFDT,X10 SET FDT ADDRESS IN I/O FCT
LA A3,FDEQT,A2 LOAD EQUIPMENT TYPE
SSL A3,3 GET JUST CLASS
TNE,U A3,2 WORD-ADDRESSABLE MASS STORAGE ?
SNONZ IOWAD,X10 YES. SET WAD INDICATOR
TG,U A3,2 IS IT TAPE ?
SNONZ IOMASS,X10 NO. SET MASS STORAGE INDICATOR
SX X10,IBIOP,A1 PUT I/O FCT ADDRESS IN PACKET
SNONZ IBLAST,A1 MARK THIS AS THE LAST BLOCK
PUT IOBB,X10 SEND THE BLOCK
P PRINTX WAIT FOR THE PRINTER
V PRINTER RELEASE THE PRINTER
BRELP X10 RELEASE THE FCT
COMPLETE . COMPLETE THE OPERATION
.
TOOSHRT LA A5,IBLEN,A1 LOAD THE LENGTH
BRELP A1 RELEASE THE BLOCK
R$DIT . START EDITING
E$MSG TOOSM EDIT THE HEADER
E$DECV A5 EDIT LENGTH
E$MSGR . COPY REST OF MESSAGE
LMJ X11,IST FILL IN REST OF MESSAGE
COMPLETE . COMPLETE THE OPERATION
.
NBS R$DIT . START EDITING
E$MSG NODAS GET THE MESSAGE
LA A0,FDIN,X5 LOAD NAME OF BLOCK
TNE A0,(' ?INTE') IS IT THE INTERNAL BLOCK ?
J NBS1 SKIP EDITING INTERNAL NAME
E$SKIP 1 SKIP A SPACE
E$FD2 FDIN,X5 EDIT THE NAME
NBS1 E$MSGR . COPY REST OF MESSAGE
LMJ X11,IST COPY STATEMENT NUMBER
COMPLETE . COMPLETE THE OPERATION
/.
.
. THE STORE COMMAND
.
STOREX* LX X6,CDBPC,X8 LOAD FIRST PARAMETER LINK
LX X5,PBVAL,X6 LOAD FDT POINTER FOR INTERNAL BLOCK
LA A1,FDBLOCK,X5 LOAD BLOCK ADDRESS
JZ A1,NBS ERROR IF NO BLOCK STORED
LX X5,PBLINK,X6 LOAD LINK TO NEXT PARAMETER
LX X5,PBVAL,X5 LOAD LINK TO BLOCK FDT
LMJ A2,BLSTORE STORE THE BLOCK COPY
COMPLETE . ALL DONE
/.
.
. THE LOAD COMMAND
.
LOADX* LX X6,CDBPC,X8 LOAD INTERNAL BLOCK LINK
LX X5,PBVAL,X6 LOAD FDT POINTER FOR INTERNAL BLOCK
LX X6,PBLINK,X6 LOAD LINK TO SECOND BLOCK
LA A1,PBVAL,X6 LOAD FDT ADDRESS
LA A1,FDBLOCK,A1 LOAD BLOCK BUFFER ADDRESS
JZ A1,NBSR ERROR IF NO BLOCK STORED
LMJ A2,BLSTORE STORE A COPY OF THE BLOCK
COMPLETE . COMPLETE THE OPERATION
.
NBSR LX X5,PBVAL,X6 LOAD ERROR FDT ADDRESS
J NBS PROCESS NO BLOCK STORED ERROR
/.
.
. THE COR COMMAND
.
CORX* LX X5,CDBPC,X8 LOAD LINK TO FIRST PARAMETER
LX X5,PBVAL,X5 LOAD LINK TO BLOCK FDT
LA A1,FDBLOCK,X5 LOAD BLOCK BUFFER ADDRESS
JZ A1,NBS ERROR IF NO BLOCK STORED
SZ FDBLOCK,X5 MARK BLOCK RELEASED
LMJ X11,PATCH GENERATE A PATCHED BLOCK
LX X5,CDBPC,X8 LOAD PARAMETER ADDRESS
LX X5,PBVAL,X5 LINK TO BLOCK FDT
LMJ A2,BLSTORE STORE THE BLOCK
BRELP A1 RELEASE THE PATCHED BUFFER
COMPLETE . COMPLETE THE COMMAND
/.
.
. THE REP COMMAND
.
REPX* LX X5,CDBPC,X8 LOAD LINK TO FIRST PARAMETER
LA A8,PBVAL,X5 LOAD STARTING WORD
LX X5,PBLINK,X5 LOAD LINK TO BLOCK DESIGNATOR
LX X6,PBLINK,X5 LOAD LINK TO THE DATA BUFFER
LX X5,PBVAL,X5 GET ADDRESS OF BLOCK FDT
LA A1,FDBLOCK,X5 LOAD BLOCK BUFFER ADDRESS
JZ A1,NBS ERROR IF NO BLOCK STORED
LA A0,PBVAL,X6 LOAD LENGTH OF DATA
AA A0,A8 ADD STARTING ADDRESS IN BLOCK
ANA,U A0,1 SUBTRACT ONE FOR TEST
TG A0,IBLEN,A1 WILL IT FIT IN CURRENT BLOCK ?
J REPXPND NO. WE'LL HAVE TO EXPAND THE BLOCK
.
XPANDN LA,U A0,PBSS,X6 LOAD START OF DATA BUFFER
LXI,U A0,1 SET UP INCREMENT
AA,U A1,IBDATA COMPUTE DATA BUFFER START
AA A1,A8 ADD OFFSET INTO THE BLOCK
LXI,U A1,1 GET INCREMENT
LR R1,PBVAL,X6 LOAD LENGTH TO MOVE
BT A1,,*A0 MOVE DATA TO BUFFER
COMPLETE . ALL DONE
.
. EXPAND BUFFER IF NECESSARY
.
REPXPND LA,U A4,1,A0 LOAD LENGTH OF DATA SEGMENT
ANU A4,IBLEN,A1 A5 = # EXTRA WORDS IN NEW BUFFER
AA,U A0,IBDATA+1 ADD LENGTH OF HEADER, WORD SUBTRACTED
BGET . ALLOCATE A NEW LONGER BUFFER
LXI,U A0,1 SET UP INCREMENT
LA A3,IBLEN,A1 LOAD DATA LENGTH OF OLD BUFFER
LR,U R1,IBDATA,A3 MOVE DATA + HEADER
SA A0,FDBLOCK,X5 REPLACE BUFFER IN FDT
LXI,U A1,1 SET UP INCREMENT
SA A1,A3 SAVE ADDRESS OF OLD BUFFER
BT A0,,*A1 MOVE DATA TO NEW BUFFER
LA,U A1,(0) LOAD ADDRESS OF ZERO WORD
LR R1,A5 LOAD COUNT OF EXTRA WORDS
BT A0,,*A1 MOVE ZEROES TO NEW BUFFER PORTION
BRELP A3 RELEASE THE OLD ONE
LA A1,FDBLOCK,X5 RELOAD BLOCK ADDRESS
SA A4,IBLEN,A1 PUT CORRECTED LENGTH IN BLOCK BUFFER
J XPANDN PROCESS NORMALLY FROM HERE
/.
.
. THE BLK COMMAND
.
BLKP* R$DIT . SET UP THE EDITOR
REMOVE PARQUE GET THE PARAMETER
LX X10,PBVAL,A1 GET ADDRESS OF BLOCK FDT
BRELP A1 RELEASE THE PARAMETER
LA A0,FDIN,X10 GET NAME OF BLOCK
TNE A0,(' ?INTE') IS IT THE INTERNAL BLOCK ?
J BLKALL YES. LIST ALL BLOCKS
LMJ X9,BLPRT NO. LIST INFO FOR THIS ONE
R$DITX . RELEASE EDITING BUFFER
J ICOUT RETURN TO COMMAND PROCESSING
.
BLKALL LX,H2 X10,BKLWD GET BKLIST HEAD
TNZ X10 ANY BLOCKS ON LIST ?
J NOBATL NO. EDIT SPECIAL MESSAGE
BLALN LMJ X9,BLPRT EDIT MESSAGE FOR THIS BLOCK
LX X10,FDLINK,X10 CHAIN TO NEXT BLOCK
TZ X10 LAST ONE ?
J BLALN NO. EDIT NEXT ONE
R$DITX . TERMINATE EDITOR
J ICOUT END OF COMMAND
.
NOBATL E$MSG NOBATM EDIT MESSAGE 'NO BLOCKS DECLARED'
R$PRTX . PRINT AND TERMINATE
J ICOUT END OF COMMAND
.
BLPRT DL A0,FDIN,X10 LOAD BLOCK NAME
TNE A0,(' ?INTE') INTERNAL BLOCK ?
DL A0,('(CURRENT)') YES. FUDGE INTERNAL NAME
E$FD2 . EDIT THE BLOCK'S NAME
E$SKIP 1 SKIP AFTER IT
LX X8,FDBLOCK,X10 GET POINTER TO DATA BLOCK
TNZ X8 ANY DATA STORED ?
J NDSBL NO. EDIT SPECIAL MESSAGE
E$MSG CONBM YES. START EDITING CONTENTS MESSAGE
E$DECV IBLEN,X8 EDIT LENGTH OF BLOCK
E$MSGR . COPY 'WORD'
LA A1,IBLEN,X8 LOAD BLOCK LENGTH
LA,U A0,'S' LOAD AN 'S'
TG,U A1,2 NEED TO PLURALISE ?
E$CHAR . YES. APPEND THE 'S'
E$MSGR . COPY ' FROM '
LX X5,IBFDT,X8 GET ADDRESS OF SOURCE FDT
LA A4,FDEQT,X5 LOAD EQUIPMENT TYPE
SSL A4,3 RIGHT JUSTIFY IT
LA A0,('BLOCK') GET TEXT FOR TAPE
TNE,U A4,3 FASTRAND FORMAT ?
LA A0,('SECTOR') YES. CALL 'EM SECTORS
TNE,U A4,2 ...OR IS IT WORD-ADDRESSABLE ?
LA A0,('WORD') THEN THEY'RE WORDS
E$FD1 . CALL IT AS YOU SEE IT
LA,U A5 CLEAR MULTIPLE PART FLAG
TLE,U A4,2 TAPE ?
J TAPBE YES. CAN'T M-PART TAPE
LA A0,IBLEN,X8 LOAD BLOCK LENGTH
TE,U A4,3 FASTRAND FORMAT ?
J WADBE NO. DON'T NEED TO CONVERT SECTORS
AA,U A0,27 ROUND FOR COVERED DIVIDE
DSA A0,36 RIGHT JUSTIFY IN A0, A1
DI,U A0,28 DIVIDE BY UNIVERSAL CONSTANT
WADBE TG,U A0,2 M-PART REQUEST ?
LA A5,A0 YES. SAVE NUMBER OF PARTS
JZ A5,TAPBE SKIP PLURALISATION IF SINGULAR
E$CHAR 'S' EDIT A TRAILING 'S'
TAPBE E$SKIP 1 SKIP A SPACE AFTER GRANULE DESIGNATION
E$DECV IBMSAD,X8 EDIT ADDRESS / BLOCK NUMBER
JZ A5,NOTDE SKIP UPPER BOUND IF SINGLE PART
E$FD3 (' TO ') EDIT TO
LA A0,IBMSAD,X8 LOAD SOURCE ADDRESS
AA A0,A5 COMPUTE UPPER GRANULE
ANA,U A0,1 BACK UP BY ONE
E$DECV . EDIT UPPER GRANULE NAME
NOTDE E$MSGR . COPY TO FILE NAME
LMJ X6,EFILE EDIT FILE NAME FROM FDT
E$CHAR '.' TERMINATE THE SENTENCE
R$PRT 1 PRINT THE LINE
J 0,X9 RETURN
.
NDSBL E$MSG NDSBM COPY NO DATA STORED MESSAGE
R$PRT 1 PRINT THE MESSAGE
J 0,X9 RETURN
/.
.
. BLOCK MANIPULATION ROUTINES
.
.
. ATTACH BLOCK TO BLOCK FDT
.
. LX,U X5,<BLOCK FDT ADDRESS>
. LA,U A1,<BLOCK BUFFER>
. LMJ A2,BLSTORE
. <RETURN>
.
BLSTORE LA A0,FDBLOCK,X5 LOAD CURRENT BLOCK ADDRESS
JZ A0,NORBY ANY BLOCK TO RELEASE ?
BRELP A0 YES. RELEASE ANY CURRENT DATA BLOCK
NORBY LA A0,IBLEN,A1 LOAD CURRENT BLOCK LENGTH
AA,U A0,IBDATA ADD LENGTH OF BLOCK HEADER
LR,U R1,,A0 SAVE LENGTH FOR MOVE LATER
BGET . ALLOCATE A BUFFER FOR THE BLOCK COPY
SA A0,FDBLOCK,X5 ATTACH BUFFER TO FDT
LXI,U A0,1 SET UP INCREMENT
LX,U X11,,A1 LOAD ADDRESS OF SOURCE BLOCK
LXI,U X11,1 GET SOURCE INCREMENT
BT A0,,*X11 COPY BLOCK INTO STORED BUFFER
J 0,A2 RETURN TO CALLING SEQUENCE
.
.
. LOAD BLOCK FROM BLOCK FDT
.
. LX,U X5,<BLOCK FDT ADDRESS>
. LMJ A2,BLLOAD
. <RETURN> A1 = <BLOCK BUFFER>
. RETURNS ZERO IF NO BLOCK STORED
.
BLLOAD LA A1,FDBLOCK,X5 LOAD STORED BLOCK ADDRESS
JZ A1,,A2 RETURN ZERO IF NO BLOCK STORED
LA A0,IBLEN,A1 LOAD LENGTH OF STORED BLOCK
AA,U A0,IBDATA ADD LENGTH OF HEADER
LR,U R1,,A0 SAVE LENGTH FOR MOVE LATER
BGET . ALLOCATE A BLOCK
LA,U A3,,A0 SAVE BLOCK ADDRESS
LXI,U A0,1 SET UP INCREMENT
LXI,U A1,1 SET UP SOURCE INCREMENT
BT A0,,*A1 COPY BLOCK
LA,U A1,,A3 LOAD COPIED BLOCK ADDRESS
J 0,A2 RETURN TO CALL
.
PURE DATA
NOBAL 'NO BLOCK STORED. PUT IGNORED FOR !'
TOOSM 'BLOCK ONLY CONTAINS ! WORDS !'
NODAS 'BLOCK! HAS NO DATA STORED !'
NDSBM 'HAS NO DATA STORED.!'
CONBM 'CONTAINS ! WORD! FROM ! OF !'
NOBATM 'NO BLOCKS ARE CURRENTLY DEFINED.!'
END