image of READY prompt

Wang2200.org

Listing of file='VSACESS1' on disk='vmedia/731-8012A.wvd.zip'

# Sector 472, program filename = 'VSACESS1'
4000 REM VSACESS1 30 JUNE 86
4002 REM % (c) Copyright Wang Laboratories, Inc. 1986
4004 REM SUPPORTS CONSECUTIVE FILE SUBROUTINES
4006 REM          READ A RECORD, WRITE A RECORD, RE-WRITE A RECORD
4008 REM          SKIP A CONSECUTIVE RECORD, LOCK & UNLOCK RECORDS
4010 REM
4012 REM % CONSECUTIVE READ SUBROUTINE ('103)
4014 REM *****************************************************************
4016 REM *  READ A CONSECUTIVE RECORD ('103)                             *
4018 REM *                                                               *
4020 REM *  FORM - GOSUB '103 (H$,H1$,"H",H)                             *
4022 REM *                                                               *
4024 REM *       WHERE     H$ = FILE HANDLE                              *
4026 REM *                H1$ = SMB\A0HEADER FOR FILE HANDLE H$            *
4028 REM *                "H" = HOLD OPTION, OTHERWISE " ".              *
4030 REM *                  H = TIMEOUT FOR HOLD (IN SECONDS)            *
4032 REM *                                                               *
4034 REM *  RETURN - V0$ = RETURN CODE (00 = ERROR IN SUBROUTINE CALL)   *
4036 REM *                             (5A = ERROR IN 2258 HANDLING)     *
4038 REM *                             (FF = OKAY CHECK SMB HDR FOR ERR) *
4040 REM *           V7$ = SMB HEADER BLOCK                              *
4042 REM *         V9$() = RETURN DATA                                   *
4044 REM *                     1 BYTE - # WORDS IN WORD BLOCK = 01       *
4046 REM *                     2 BYTE - # OF RECORDS READ                *
4048 REM *                     2 BYTE - # BYTES IN BYTE BLOCK            *
4050 REM *                            DATA READ                          *
4052 REM *                            1 BYTE DATABLOCK ID = 01           *
4054 REM *                            2 BYTE # BYTES READ                *
4056 REM *                            X BYTE DATA READ                   *
4058 REM *                                                               *
4060 REM *  EXAMPLE                                                      *
4062 REM *      10 DIM C1$5,N1$30,B1$3,W$8,H$2,H1$32                     *
4064 REM *      20 W$=HEX(A005A01EA0035205)                              *
4066 REM *      30 GOSUB '103 (H$, H1$, " ")                             *
4068 REM *      40 IF V0$ <> HEX(00) THEN 60                             *
4070 REM *      50 STOP "ERROR IN READ"                                  *
4072 REM *      60 $UNPACK (F=W$) STR(V9$(),9) TO C1$,N1$,B1$,A1         *
4074 REM *                                                               *
4076 REM *****************************************************************
4078    DEFFN '103 (V9$,V7$,V3$,V6)
4080 REM UPDATE COMMAND AND INIT ERRORS IN SMB\A0HDR
   : STR(V7$,6,4)=HEX(00090000)
4082 REM READ A CONSECUTIVE RECORD CMD STRUCTURE
   : STR(V8$())=HEX(04) & V9$
4084 REM CHECK IF HOLD
   : IF V3$<>" " THEN 4086
   : STR(V8$(),4,2),STR(V8$(),8,2)=HEX(0000)
   : GOTO 4088
4086 REM HOLD
   : STR(V8$(),4,2)="HH"
   : STR(V8$(),8,2)=BIN(V6,2)
4088 STR(V8$(),6,2)=HEX(0001)
   : STR(V8$(),10,3)=HEX(000000)
4090 REM SEND REQUEST TO 2258 AND ACCEPT REPLY 01 0001 01 XXXX DD DD DD ... 00
   : GOSUB '199
   : IF V0$<>HEX(FF) THEN 4098
4092 REM SET UP SMB HEADER
   : V7$=STR(V9$(),1,32)
   : IF STR(V7$,6,1)<>HEX(00) THEN 4100
4094 REM SET UP RETURN DATA
   : V1=VAL(STR(V8$,3,2),2)-32
   : STR(V9$(),1,V1)=STR(V9$(),33,V1)
   : STR(V9$(),V1+1)=ALL(" ")
4096 REM GOOD RETURN
   : V0$=HEX(FF)
4098 RETURN
4100 V0$=HEX(00)
   : RETURN
4102 REM % CONSECUTIVE WRITE SUBROUTINE ('104)
4104 REM *****************************************************************
4106 REM *  WRITE A CONSECUTIVE RECORD ('104)                            *
4108 REM *                                                               *
4110 REM *  FORM - GOSUB '104 (H$,H1$,D$)                                *
4112 REM *                                                               *
4114 REM *       WHERE     H$ = FILE HANDLE                              *
4116 REM *                H1$ = SMB\A0HEADER FOR FILE HANDLE H$            *
4118 REM *                 D$ = WRITE DATA BUFFER                        *
4120 REM *                                                               *
4122 REM *  RETURN - V0$ = RETURN CODE (00 = ERROR IN SUBROUTINE CALL)   *
4124 REM *                             (5A = ERROR IN 2258 HANDLING)     *
4126 REM *                             (FF = OKAY CHECK SMB HDR FOR ERR) *
4128 REM *           V7$ = SMB HEADER BLOCK                              *
4130 REM *         V9$() = RETURN DATA                                   *
4132 REM *                  1 BYTE - # OF WORDS IN WORD BLOCK = 01       *
4134 REM *                  2 BYTE - # OF BYTES WRITTEN                  *
4136 REM *                  2 BYTE - # OF BYTES IN BYTE BLOCK = 0000     *
4138 REM *                                                               *
4140 REM *  EXAMPLE                                                      *
4142 REM *      10 DIM C1$5,N1$30,B1$3,W$8,D$43,H$2,H1$32                *
4144 REM *      20 W$=HEX(A005A01EA0035205)                              *
4146 REM *      30 $PACK (F=W$) D$ FROM C1$,N1$,B1$,A1                   *
4148 REM *      40 GOSUB '104 (H$, H1$, D$)                              *
4150 REM *      50 IF V0$ <> HEX(00) THEN 70                             *
4152 REM *      60 STOP "ERROR IN WRITE"                                 *
4154 REM *      70 ......                                                *
4156 REM *                                                               *
4158 REM *****************************************************************
4160    DEFFN '104 (V9$,V7$,V9$())
4162 REM UPDATE COMMAND AND INIT ERRORS IN SMB\A0HDR
   : STR(V7$,6,4)=HEX(00110000)
4164 REM READ A CONSECUTIVE RECORD CMD STRUCTURE
   : STR(V8$())=HEX(02) & V9$
4166 V1=LEN(V9$())
   : STR(V8$(),4,V1+8)=HEX(0001)&BIN(V1+3,2)&HEX(01)&BIN(V1,2)&STR(V9$(),1,V1)
     &HEX(00)
4168 REM SEND REQUEST TO 2258 AND ACCEPT REPLY 01 0001 01 00
   : GOSUB '199
   : IF V0$<>HEX(FF) THEN 4176
4170 REM SET UP SMB HEADER
   : V7$=STR(V9$(),1,32)
   : IF STR(V7$,6,1)<>HEX(00) THEN 4178
4172 REM SET UP RETURN DATA
   : V1=VAL(STR(V8$,3,2),2)-32
   : STR(V9$(),1,V1)=STR(V9$(),33,V1)
   : STR(V9$(),V1+1)=ALL(" ")
4174 REM GOOD RETURN
   : V0$=HEX(FF)
4176 RETURN
4178 V0$=HEX(00)
   : RETURN
4180 REM % CONSECUTIVE RE-WRITE SUBROUTINE ('105)
4182 REM *****************************************************************
4184 REM * RE-WRITE A CONSECUTIVE RECORD ('105)                          *
4186 REM *                                                               *
4188 REM *  FORM - GOSUB '105 (H$,H1$,L,D$)                              *
4190 REM *                                                               *
4192 REM *       WHERE     H$ = FILE HANDLE                              *
4194 REM *                H1$ = SMB\A0HEADER FOR FILE HANDLE H$            *
4196 REM *                  L = LENGTH OF RECORD TO BE WRITTEN           *
4198 REM *                 D$ = WRITE DATA BUFFER                        *
4200 REM *                                                               *
4202 REM *  RETURN - V0$ = RETURN CODE (00 = ERROR IN SUBROUTINE CALL)   *
4204 REM *                             (5A = ERROR IN 2258 HANDLING)     *
4206 REM *                             (FF = OKAY CHECK SMB HDR FOR ERR) *
4208 REM *           V7$ = SMB HEADER BLOCK                              *
4210 REM *         V9$() = RETURN DATA                                   *
4212 REM *                  1 BYTE - # OF WORDS IN WORD BLOCK = 00       *
4214 REM *                  2 BYTE - # OF BYTES IN BYTE BLOCK = 0000     *
4216 REM *                                                               *
4218 REM *  EXAMPLE                                                      *
4220 REM *      10 DIM C1$5,N1$30,B1$3,W$8,D$43,H$2,H1$32                *
4222 REM *      20 W$=HEX(A005A01EA0035205)                              *
4224 REM *      30 $PACK (F=W$) D$ FROM C1$,N1$,B1$,A1                   *
4226 REM *      40 GOSUB '105 (H$, H1$, 41, D$)                          *
4228 REM *      50 IF V0$ <> HEX(00) THEN 70                             *
4230 REM *      60 STOP "ERROR IN RE-WRITE"                              *
4232 REM *      70 ......                                                *
4234 REM *                                                               *
4236 REM *****************************************************************
4238    DEFFN '105 (V9$,V7$,V1,V9$())
4240 REM UPDATE COMMAND AND INIT ERRORS IN SMB\A0HDR
   : STR(V7$,6,4)=HEX(00160000)
4242 REM RE-WRITE A CONSECUTIVE RECORD CMD STRUCTURE
   : STR(V8$())=HEX(01) & V9$
4244 STR(V8$(),4,V1+6)=BIN(V1+3,2)&HEX(01)&BIN(V1,2)&STR(V9$(),1,V1)&HEX(00)
4246 REM SEND REQUEST TO 2258 AND ACCEPT REPLY 00 0000
   : GOSUB '199
   : IF V0$<>HEX(FF) THEN 4252
4248 REM SET UP SMB HEADER
   : V7$=STR(V9$(),1,32)
   : IF STR(V7$,6,1)<>HEX(00) THEN 4254
4250 REM SET UP RETURN DATA
   : V1=VAL(STR(V8$,3,2),2)-32
   : STR(V9$(),1,V1)=STR(V9$(),33,V1)
   : STR(V9$(),V1+1)=ALL(" ")
4252 RETURN
4254 V0$=HEX(00)
   : RETURN
4256 REM % CONSECUTIVE SKIP SUBROUTINE ('106)
4258 REM *****************************************************************
4260 REM * SKIP N NUMBER OF CONSECUTIVE RECORDS ('106)                   *
4262 REM *                                                               *
4264 REM *  FORM - GOSUB '106 (H$,H1$,R)                                 *
4266 REM *                                                               *
4268 REM *       WHERE     H$ = FILE HANDLE                              *
4270 REM *                H1$ = SMB\A0HEADER FOR FILE HANDLE H$            *
4272 REM *                  R = NUMBER OF RECORDS TO SKIP                *
4274 REM *                      RELATIVE FROM CURRENT POSITION           *
4276 REM *                      NEGATIVE IS BACKWARDS SKIP               *
4278 REM *                                                               *
4280 REM *  RETURN - V0$ = RETURN CODE (00 = ERROR IN SUBROUTINE CALL)   *
4282 REM *                             (5A = ERROR IN 2258 HANDLING)     *
4284 REM *                             (FF = OKAY CHECK SMB HDR FOR ERR) *
4286 REM *           V7$ = SMB HEADER BLOCK                              *
4288 REM *         V9$() = RETURN DATA                                   *
4290 REM *                  1 BYTE - # OF WORDS IN WORD BLOCK = 00       *
4292 REM *                  2 BYTE - # OF BYTES IN BYTE BLOCK = 0000     *
4294 REM *                                                               *
4296 REM *  EXAMPLE                                                      *
4298 REM *      30 R = 30                                                *
4300 REM *      40 GOSUB '106 (H$, H1$, R)                               *
4302 REM *      50 IF V0$ <> HEX(00) THEN 70                             *
4304 REM *      60 STOP "ERROR IN SKIP"                                  *
4306 REM *      70 ......                                                *
4308 REM *                                                               *
4310 REM *****************************************************************
4312    DEFFN '106 (V9$,V7$,V7)
4314 REM UPDATE COMMAND AND INIT ERRORS IN SMB\A0HDR
   : STR(V7$,6,4)=HEX(00270000)
4316 REM SKIP CONSECUTIVE COMMAND STRUCTURE
   : STR(V8$())=HEX(03) & V9$
4318 REM 32 BIT COUNT OF RECORDS TO SKIP
   : IF V7 >= (2^32) OR V7 <=(-2^32) THEN 4332
   : IF V7 < 0 THEN 4320
   : V1=INT(V7/(2^16))
   : STR(V8$(),4,2)=BIN(V1,2)
   : STR(V8$(),6,2)=BIN(V7-V1*2^16,2)
   : GOTO 4322
4320 REM NEGATIVE SKIP
   : V7=ABS(V7)
   : V1=INT(V7/(2^16))
   : STR(V8$(),4,2)=BIN(V1,2)
   : STR(V8$(),6,2)=BIN(V7-V1*2^16,2)
   : STR(V8$(),4,4) = XOR HEX(FFFFFFFF) ADDC HEX(01)
4322 REM BYTE BLOCK & COMMAND TRAILER
   : STR(V8$(),8,3)=HEX(000000)
4324 REM SENT REQUEST TO 2200, GET BACK 00 0000
   : GOSUB '199
   : IF V0$<>HEX(FF) THEN 4334
4326 REM SET UP SMB HEADER
   : V7$=STR(V9$(),1,32)
   : IF STR(V7$,6,1)<>HEX(00) THEN 4332
4328 REM SET UP RETURN DATA
   : V1=VAL(STR(V8$,3,2),2)-32
   : STR(V9$(),1,V1)=STR(V9$(),33,V1)
   : STR(V9$(),V1+1)=ALL(" ")
4330 REM GOOD RETURN
   : V0$=HEX(FF)
   : GOTO 4334
4332 REM SUBR ERROR
   : V0$=HEX(00)
4334 REM RETURN
   : RETURN
4336 REM % CONSECUTIVE LOCK SUBROUTINE ('107)
4338 REM *****************************************************************
4340 REM * LOCK A CONSECUTIVE FILE ('107)                                *
4342 REM *                                                               *
4344 REM *  FORM - GOSUB '107 (H$, H1$, M$)                              *
4346 REM *                                                               *
4348 REM *       WHERE     H$ = FILE HANDLE                              *
4350 REM *                H1$ = SMB\A0HEADER FOR FILE HANDLE H$            *
4352 REM *                 M$ = FILE OPEN MODE                           *
4354 REM *                                                               *
4356 REM *  RETURN - V0$ = RETURN CODE (00 = ERROR IN SUBROUTINE CALL)   *
4358 REM *                             (5A = ERROR IN 2258 HANDLING)     *
4360 REM *                             (FF = OKAY CHECK SMB HDR FOR ERR) *
4362 REM *           V7$ = SMB HEADER BLOCK                              *
4364 REM *         V9$() = RETURN DATA                                   *
4366 REM *                  1 BYTE - # OF WORDS IN WORD BLOCK = 00       *
4368 REM *                  2 BYTE - # OF BYTES IN BYTE BLOCK = 0000     *
4370 REM *                                                               *
4372 REM *  EXAMPLE                                                      *
4374 REM *      40 GOSUB '107 (H$,H1$,M$)                                *
4376 REM *      50 IF V0$ <> HEX(00) THEN 70                             *
4378 REM *      60 STOP "ERROR IN LOCK"                                  *
4380 REM *      70 ......                                                *
4382 REM *                                                               *
4384 REM *****************************************************************
4386    DEFFN '107 (V9$,V7$,V2$)
4388 REM UPDATE COMMAND AND INIT ERRORS IN SMB\A0HDR
   : STR(V7$,6,4)=HEX(001F0000)
4389 REM / Modified lines 4390, 4392, 4394 and 4396 to implement CONSECUTIVE
        LOCK through ROCStart for 2200SRV Rel 01.60.00 and above/Ram/19 Oct.,
     '90/
4390 REM LOCK CONSECUTIVE COMMAND STRUCTURE
   : STR(V8$())=HEX(02) & V9$ &  "HH" & HEX(00000000)
4392 REM INIT FUTURE VALUES
   : REM STR(V8$(),4,6)=HEX(00 00 00 00 00 00)
4394 REM FILE OPEN MODE
   : REM V1=POS("           SXER"=V2$)
   : REM IF V1<12 OR V1>15 THEN 4410
   : REM V2=2^V1
   : REM STR(V8$(),10,2)=BIN(V2,2)
4396 REM BYTE BLOCK & COMMAND TRAILER
   : REM STR(V8$(),12,3)=HEX(00 00 00)
4398 REM SENT REQUEST TO 2200, GET BACK 00 0000
   : GOSUB '199
   : IF V0$<>HEX(FF) THEN 4408
4400 REM SET UP SMB HEADER
   : V7$=STR(V9$(),1,32)
   : IF STR(V7$,6,1)<>HEX(00) THEN 4410
4402 REM SET UP RETURN DATA
   : V1=VAL(STR(V8$,3,2),2)-32
   : STR(V9$(),1,V1)=STR(V9$(),33,V1)
   : STR(V9$(),V1+1)=ALL(" ")
4404 REM GOOD RETURN
   : V0$=HEX(FF)
4406 REM INIT
4408 RETURN
4410 V0$=HEX(00)
   : RETURN
4412 REM % CONSECUTIVE UNLOCK SUBROUTINE ('108)
4414 REM *****************************************************************
4416 REM * UNLOCK A CONSECUTIVE FILE ('108)                              *
4418 REM *                                                               *
4420 REM *  FORM - GOSUB '108 (H$,H1$)                                   *
4422 REM *                                                               *
4424 REM *       WHERE     H$ = FILE HANDLE                              *
4426 REM *                H1$ = SMB\A0HEADER FOR FILE HANDLE H$            *
4428 REM *                                                               *
4430 REM *  RETURN - V0$ = RETURN CODE (00 = ERROR IN SUBROUTINE CALL)   *
4432 REM *                             (5A = ERROR IN 2258 HANDLING)     *
4434 REM *                             (FF = OKAY CHECK SMB HDR FOR ERR) *
4436 REM *           V7$ = SMB HEADER BLOCK                              *
4438 REM *         V9$() = RETURN DATA                                   *
4440 REM *                  1 BYTE - # OF WORDS IN WORD BLOCK = 00       *
4442 REM *                  2 BYTE - # OF BYTES IN BYTE BLOCK = 0000     *
4444 REM *                                                               *
4446 REM *  EXAMPLE                                                      *
4448 REM *      40 GOSUB '108 (H$,H1$)                                   *
4450 REM *      50 IF V0$ = HEX(FF) THEN 70                              *
4452 REM *      60 STOP "ERROR IN UNLOCK"                                *
4454 REM *      70 ......                                                *
4456 REM *                                                               *
4458 REM *****************************************************************
4460    DEFFN '108 (V9$,V7$)
4461 REM /Modified lines 4462 and 4464 to implement CONSECUTIVE UNLOCK through
       ROCStart for 2200SRV Rel 01.60.00 and above/Ram/19 Oct., '90/
4462 REM UPDATE COMMAND AND INIT ERRORS IN SMB\A0HDR
   : STR(V7$,6,4)=HEX(001F0000)
4464 REM UNLOCK CONSECUTIVE COMMAND STRUCTURE
   : STR(V8$())=HEX(02) & V9$ & HEX(0202) & HEX(00000000)
4466 REM SENT REQUEST TO 2200, GET BACK 00 0000
   : GOSUB '199
   : IF V0$<>HEX(FF) THEN 4474
4468 REM SET UP SMB HEADER
   : V7$=STR(V9$(),1,32)
   : IF STR(V7$,6,1)<>HEX(00) THEN 4476
4470 REM SET UP RETURN DATA
   : V1=VAL(STR(V8$,3,2),2)-32
   : STR(V9$(),1,V1)=STR(V9$(),33,V1)
   : STR(V9$(),V1+1)=ALL(" ")
4472 REM GOOD RETURN
   : V0$=HEX(FF)
4474 RETURN
4476 V0$=HEX(00)
   : RETURN
4478 DEFFN'31 "N$=";HEX(22);"VSACESS1";HEX(22);":SCRATCH T N$: SAVE T () N$"